Loop through column and copy to new column depending on condition

[ghdub]

I have recently taken an interest in VBA, Despite searching through various forums I am unable to figure out how to do what I need.

I want to loop through column A (which is a list of names), if the first letter begins with 'a' I want to copy into column c,

This is what I have so far:

Sub copy data()
' 1. Get the worksheet
Dim shNames As Worksheet
Set shNames = ThisWorkbook.Worksheets("Names")
' 2. Get Range
Dim r As Range
Set r = shNames.Range("A1:A100")
' 3. Clear existing formats
r.ClearFormats

Dim rCell As Range
For Each rCell In r
' Check if the first letter of name is A
For i = 1 To 100
If Left(rCell.Value, 1) = "A" Then ????????????




End If
Next rCell

 

[Joe4]

Welcome to the Board!

Since you have already set your range as A1:A100 and are looping through that, you don't want/need a second loop (for 1 to 100).
It should just look something like this:

[COLOR=#333333]Dim rCell As Range[/COLOR]
[COLOR=#333333]For Each rCell In r[/COLOR]
[COLOR=#333333]' Check if the first letter of name is A, and copy to column C[/COLOR]
[COLOR=#333333]    If Left(rCell.Value, 1) = "A" Then rCell.Offset(0,2).Value = rCell.Value
Next rCell
[/COLOR]

 

[ghdub]

Thanks Joe, appreciate you taking time to reply
However, what I need is for the data to copy to the top of Column C (not offset).
EG (If the macro finds 3 valid entries in column A it copies the values to cells C1,C2 and C3

 

[Joe4]

Then just add a counter, i.e.

[COLOR=#333333]Dim rCell As Range
[/COLOR]Dim myRow as Long
'Initialize myRow
myRow = 0
[COLOR=#333333]For Each rCell In r[/COLOR]
[COLOR=#333333]' Check if the first letter of name is A, and copy to column C[/COLOR]
[COLOR=#333333]    If Left(rCell.Value, 1) = "A" Then 
      myRow = myRow + 1
      Cells(myRow,"C").Value = rCell.Value
Next rCell[/COLOR]

 

[ghdub]

Hello Joe, thanks again for you input, my new code is below, however, whilst it is now copying values to the top of column C, it is no longer copying values that begin with the letter A
Do you have any idea why?

Sub Find_name_and_copy()
Dim shNames As Worksheet
Set shNames = ThisWorkbook.Worksheets("Names")
Dim r As Range
Set r = shNames.Range("A1:A100")

Dim newRow As Long
myRow = 0

Dim rCell As Range

For Each rCell In r


If Left(rCell.Value, 1) = "A" Then myRow = myRow + 1
Cells(myRow, "C").Value = rCell.Value
Next rCell
End Sub

 

[Joe4]

Whoops. I forgot the END IF part of my code. Note the structure of the IF statement. It is important not to have anything after the word THEN on that line, but rather have it on the next line.

[COLOR=#333333]Dim rCell As Range
[/COLOR]Dim myRow as Long
'Initialize myRow
myRow = 0
[COLOR=#333333]For Each rCell In r[/COLOR]
[COLOR=#333333]' Check if the first letter of name is A, and copy to column C[/COLOR]
[COLOR=#333333]    If Left(rCell.Value, 1) = "A" Then 
      myRow = myRow + 1
      Cells(myRow,"C").Value = rCell.Value
    End If
Next rCell[/COLOR]

Sorry for the confusion.

 

[Rick Rothstein]

Here is alternate method to do what you asked for...

[table="******* 500"]
[tr]
	[td]Sub FindNameAndCopy()
  Sheets("Names").Range("C1:C100") = Evaluate("IF(LEFT(Names!A1:A100)=""A"",Names!A1:A100,"""")")
  On Error GoTo AllNamesBeginWithA
  Sheets("Names").Range("C1:C100").SpecialCells(xlBlanks).Delete xlShiftUp
AllNamesBeginWithA:
End Sub[/td]
[/tr]
[/table]

 

[ghdub]

Thanks Joe, thanks Rick,
both are very helpful, gives me something to work with