Trying to Transfer the Contents of a Cell to a Cell in another Sheet

[Izran]

The title pretty much state's my basic problem, but it's a hair more
complicated than that. I've got to filter through a fairly large
spreadsheet (Air_List) and find all rows that contain a value in a
specific column. After finding said rows, I gotta find all the columns
in that row that contain data. All this found data then needs to be
placed on another sheet (Commodity_Entry). The presentation of the
data differs too, as I will then take the row values and present them
in a column.

Example:

The Sheet with the cells to be transferred from:

Name data 1 data 2 data 3
ann 72 86 22
Bill 44 93
Jan 82


The Sheet with the cells to be transferred to:


Ann
72
86
22
Bill
44
93
Jan
82


Now I will warn you that I have just started writing VBA, but am fairly
proficient in C and C++. Here is the code I've developed to try and
accomplish this.




Sub Air_Service_View()

Dim iRowCountFrom As Integer, iColCountFrom As Integer
Dim iRowCountTo As Integer, iColCountTo As Integer
Dim iColumnCountMMM As Integer

Dim rFromCell As Range
Dim rToCell As Range
Dim iListMax As Integer

iRowCountTo = 10
iRowCountTo = 4
iColumnCountTo = 2
iColumnCountFrom = 2

iListMax = Sheets("Air_List").Range("A1")


'Sheets("Air_List").Range("A1")Contains the number of used cells in
that row

For iRowCountFrom = 4 To iListMax + 3

If Not IsNull(Sheets("Air_List").Cells(iRowCountFrom, 2).Text)
Then
Sheets("Commodity_Entry").Cells(iRowCountTo, 2).Text =
Sheets("Air_List").Cells(iRowCountFrom, 2).Text


'find MMMs
For iColCountMMM = 4 To 31

If Not
IsNull(Sheets("Air_List").Cells(iRowCountFrom, iColCountMMM).Text) Then

iRowCountTo = iRowCountTo + 1
Sheets("Commodity_Entry").Cells(iRowCountTo,
2).Text = _
Sheets("Air_List").Cells(iRowCountFrom,
iColCountMMM).Text

End If


Next iColCountMMM

End If


Next iRowCountFrom


End Sub





The big problem I'm having is that it's not recognizing the cells that
I am trying to transfer to. I keep getting a Subscript out of Range
error with them, but ironically it does recoginze the cells I am
transferring from. Of note is that I am starting at cell B4 in the
from sheet (Column B has a value if anything in that row has a value),
and transferring to the Commodity_Entry sheet starting at cell B10. I
am trying to not get too specific in naming as I need to apply this
algarythm to 20+ other databases.


Regards,
Michael P Manzi

 

[Tom Ogilvy]

IsNull will only return True if the value actuall is the value NULL. An
empty cell is empty, not NULL.

TEXT is a read only property of a range/cell. Use VALUE

Sub Air_Service_View()

Dim Sh1 as worksheet
Dim Sh2 as Worksheet
Dim iRowCountFrom As Integer, iColCountFrom As Integer
Dim iRowCountTo As Integer, iColCountTo As Integer
Dim iColumnCountMMM As Integer

Dim rFromCell As Range
Dim rToCell As Range
Dim iListMax As Integer

iRowCountTo = 9
iRowCountTo = 4
iColumnCountTo = 2
iColumnCountFrom = 2

Set sh1 = Sheets("Air_List")
Set sh2 = Sheets("Commodity_Entry")

iListMax = Sheets("Air_List").Range("A1")
For iRowCountFrom = 4 To iListMax + 3
If Not IsEmpty(sh1.Cells(iRowCountFrom, 2).Value) Then
iRowCountTo = iRowCountTo + 1
sh.Cells(iRowCountTo, 2).Value = _
sh1.Cells(iRowCountFrom, 2).Text
'find MMMs
For iColCountMMM = 4 To 31
If Not isEmpty(sh1.Cells(iRowCountFrom, _
iColCountMMM).Value) Then
iRowCountTo = iRowCountTo + 1
Sh2.Cells(iRowCountTo,2).Value = _
Sh1.Cells(iRowCountFrom,iColCountMMM).Value
End If
Next iColCountMMM
End If
Next iRowCountFrom


End Sub

 

[Bob Phillips]

Sub Test()
Dim iLastRow As Long
Dim iLastCol As Long
Dim i As Long
Dim j As Long
Dim k As Long

iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
For i = 2 To iLastRow
If Cells(i, "A").Value <> "" Then
iLastCol = Cells(i, Columns.Count).End(xlToLeft).Column
For j = 1 To iLastCol
If Cells(i, j).Value <> "" Then
k = k + 1
Cells(i, j).Copy Worksheets("NewSheet").Cells(k, "A")
End If
Next j
End If
Next i

End Sub


--

HTH

RP
(remove nothere from the email address if mailing direct)

 

[Izran]

WooHoo!! TYVM. It worked - a few typos, but I managed to correct them
- amazing how a stray space in a tab name (barely recognizable) can
perplex you for hours.

Regards,
Mike

P.S. There is one object you left as .Text that needs to made .Value
and on "sh" missing a number that should be "sh2" for anyone who wishes
to use this thread for help.

 

[ptrively]

Not trying to over simplify things, but there are some very easy methods to
do what you're doing, you can even use the record macro function to pick
them up (since you said you're not a VB developer).

The first is use the auto-filter function to pick out the columns you
want.

The code looks something like this:

Range("A11").Select
Selection.AutoFilter
Selection.AutoFilter Field:=3, Criteria1:="=""Your Value""",
Operator:= _
xlAnd

Although you don't need to code that, just use the record macro function.
What it will allow you to do is filter out every row that doesn't have the
value you want (in your case that value might even be no value at all).

Once you've applied the filter, you could consider using the transpose
function.

Range("A55").Select
Selection.Copy
Range("F5").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:=True

Transpose takes a vertical or horizontal "Copy" and pastes it in the
opposite fashion.

You of course can use variables to get the data...

Range("A"&iFirstRow:"E"&iLastRow).Copy

The & character will concatenate just about anything!

Hopefully this sparks some wheels turning. If I had more time I'd sift
through your code, but I'm just about to run out the door!

Good Luck,

Paul

 

[Izran]

Again, thank you all for your input as they aided me greatly.

Regards,
MPManzi

 

[Izran]

The cell value that I am passing contains a hyperlink, is there a way
to pass the link with the value as well???

 

[Tom Ogilvy]

Dim rng1 as Range
Dim rng2 as Range


If Not isEmpty(sh1.Cells(iRowCountFrom, _
iColCountMMM).Value) Then
iRowCountTo = iRowCountTo + 1
set rng1 = Sh1.Cells(iRowCountFrom,iColCountMMM)
set rng2 = Sh2.Cells(iRowCountTo,2)
if rng.hyperlinks.Count > 0 then
rng1.copy rng2
end if
rng2.Value = rng1.Value
End If

Copying and pasting will copy and paste the hyperlink

It will also transfer formatting, so if that is a problem, you might have to
get more involved.