Unsure of Loop

[Davebro]

I am looking to find a loop through my macro.

Sub Macro1()
'


'
ActiveCell.Select
Selection.Copy
ActiveCell.Offset(8, -1).Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste
ActiveCell.Select
Selection.End(xlDown).Select
ActiveCell.Offset(4, 1).Range("A1").Select

End Sub

 

[Joe4]

So, are we going to overwrite the number "1" in cell A12 with the word "Item 1"?

Please actually walk me through the first 3 or 4 so I can see the actual pattern.
Remember, the problem is familar to you, because you know what you want it to do. But all we have to go on is what you tell us.
So please be as detailed as possible, if you would ike us to help you.
If you walk me through the first 3 or 4 iterations, I will (hopefully) then see the pattern.

 

[Davebro]

So, are we going to overwrite the number "1" in cell A12 with the word "Item 1"?

Please actually walk me through the first 3 or 4 so I can see the actual pattern.
Remember, the problem is familar to you, because you know what you want it to do. But all we have to go on is what you tell us.
So please be as detailed as possible, if you would ike us to help you.
If you walk me through the first 3 or 4 iterations, I will (hopefully) then see the pattern.

The macro copies B4 and moves down to A12 to paste from A12 down until it reaches an empty cell. So overwrite the number "1" in cell A12 with the word "Item 1"

 

[Joe4]

OK, if I understand you correctly, let's see if this does what you want:

Sub MyCopyMacro()

    Dim lrb As Long
    Dim r As Long
    Dim lra As Long
    Dim str As String

    Application.ScreenUpdating = False
   
'   Find last row in column B with data
    lrb = Cells(Rows.Count, "B").End(xlUp).Row
   
'   Loop through all rows in column B
    For r = 1 To lrb
'       Check to see if entry in column B starts with "ITEM"
        If Left(Cells(r, "B"), 4) = "ITEM" Then
'           Paste value to column A
            str = Cells(r, "B")
            lra = Cells(r + 8, "A").End(xlDown).Row
            Range(Cells(r + 8, "A"), Cells(lra, "A")) = str
        End If
    Next r
   
    Application.ScreenUpdating = True

End Sub

 

[Davebro]

OK, if I understand you correctly, let's see if this does what you want:

Sub MyCopyMacro()

    Dim lrb As Long
    Dim r As Long
    Dim lra As Long
    Dim str As String

    Application.ScreenUpdating = False
  
'   Find last row in column B with data
    lrb = Cells(Rows.Count, "B").End(xlUp).Row
  
'   Loop through all rows in column B
    For r = 1 To lrb
'       Check to see if entry in column B starts with "ITEM"
        If Left(Cells(r, "B"), 4) = "ITEM" Then
'           Paste value to column A
            str = Cells(r, "B")
            lra = Cells(r + 8, "A").End(xlDown).Row
            Range(Cells(r + 8, "A"), Cells(lra, "A")) = str
        End If
    Next r
  
    Application.ScreenUpdating = True

End Sub

Hi again, many thanks for this, it has worked, I just need now to replace the "Check to see if entry in column B starts with "ITEM"
and "if Left(Cells(r, "B"), 4) = "ITEM" Then"

The "ITEM" changes from section to section.

 

[Joe4]

Hi again, many thanks for this, it has worked, I just need now to replace the "Check to see if entry in column B starts with "ITEM"
and "if Left(Cells(r, "B"), 4) = "ITEM" Then"

The "ITEM" changes from section to section.

If you need help with that, you are going to have to provide a bit more detail than that. We need some sort of way to identifty what we are looking for and how to differentiate it from the other stuff.

 

[Davebro]

Most

If you need help with that, you are going to have to provide a bit more detail than that. We need some sort of way to identifty what we are looking for and how to differentiate it from the other stuff.

Most of the time it is a changing time eg 16:50:00 or it might be a date. It is just a matter of whatever is in B4 or other B cells to move it to A12 or next A.

 

[Joe4]

If it is always a set cell, like B4, that is not a problem. We can tell it to move specific cells, if we know their address.
But the issue then, is how do we identify the other cells after that to move, if it is not always going to be the same specific cell addresses?

Are the entries in the cells that you want copied valid date/time entries?
One way to check, is to enter this formula in a blank cell in Excel and tell me what it returns:
=ISNUMBER(B4)
If that returns TRUE, then you have a valid Date/Time entry. If it returns FALSE, you do not.

And then, the next question is are all other cells in column B that you want to ignore NOT date/time entries (so they differ from the cells you want to copy)?

 

[Davebro]

B4 came back False.
Tt

If it is always a set cell, like B4, that is not a problem. We can tell it to move specific cells, if we know their address.
But the issue then, is how do we identify the other cells after that to move, if it is not always going to be the same specific cell addresses?

Are the entries in the cells that you want copied valid date/time entries?
One way to check, is to enter this formula in a blank cell in Excel and tell me what it returns:
=ISNUMBER(B4)
If that returns TRUE, then you have a valid Date/Time entry. If it returns FALSE, you do not.

And then, the next question is are all other cells in column B that you want to ignore NOT date/time entries (so they differ from the cells you want to copy)?

B4 came back False.
There are 34 columns in all but they do not change only the cells in column A need changing to whatever is in B4 (or next B) cell down to the next blank cell.

 

[Joe4]

Can you post an actual sampling of what the data in column B really looks like?

 

[Davebro]

Can you post an actual sampling of what the data in column B really looks like?

Can you post an actual sampling of what the data in column B really looks like?

I think I have cracked it although I am getting a an error on

ActiveCell.Offset(4, 1).Range("A1").Select

when the macro has finished.

Have just run it through 1,000 rows and it has worked out.

Sub Macro1()
'
For x = 1 To 50

ActiveCell.Select
Selection.Copy
ActiveCell.Offset(8, -1).Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste
ActiveCell.Select
Selection.End(xlDown).Select
ActiveCell.Offset(4, 1).Range("A1").Select

Next x
End Sub