How To Loop Macro

[michaeljamesellis]

I have the following macro which I need to loop until there is no value in the first step (Range ("A2").Select.

Any guidance on how best to achieve this would really be appreciated.

Thank you

Sub Macro7()
'
' Macro7 Macro
'

'
Range("A2").Select
Selection.Copy
Sheets("Raw Data").Select
Columns("D:D").Select
Selection.Find(What:="Company Name", After:=ActiveCell, LookIn:= _
xlFormulas2, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Activate
Range("A1538:C1538").Select
Range("C1538").Activate
Application.CutCopyMode = False
Selection.Copy
Sheets("Ultimate Output").Select
Range("B2").Select
ActiveSheet.Paste
Range("A2:D2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Ultimate Output (2)").Select
Range("A2").Select
ActiveSheet.Paste
Rows("2:2").Select
Application.CutCopyMode = False
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Sheets("Ultimate Output").Select
Rows("2:2").Select
Selection.Delete Shift:=xlUp
Range("A1").Select
End Sub

 

[rlv01]

Most of your code does not do anything. The part that does do something, does not appear to do anything very useful, so who knows if this will work, but here is some code that will loop until WorkSheets("Ultimate Output").Range("A2") is empty.

Sub Macro7_mod()
    '
    ' Macro7 Macro
    '
    Application.ScreenUpdating = False
    Do While Trim(Sheets("Ultimate Output").Range("A2").Value) <> ""
        Sheets("Raw Data").Range("A1538:C1538").Copy Sheets("Ultimate Output").Range("B2")
        Sheets("Ultimate Output").Range("A2:D2").Copy Sheets("Ultimate Output (2)").Range("A2")
        Sheets("Ultimate Output (2)").Rows("2:2").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        Sheets("Ultimate Output").Rows("2:2").Delete Shift:=xlUp
    Loop
    Application.ScreenUpdating = True
End Sub

 

[SunnyAlv]

I'm trying to understand your vba code, do you just want to find ‘Company Name’ in Raw Data sheet, then you copy it in ‘Ultimate Output (2)’ sheet? ?

I'm confused :v

 

[michaeljamesellis]

Thanks for the comments so far.

The code is trying to search for a phrase within a poorly structured cell containing lots of companies all separated by inconsistent use of , . - and spaces. Some of these naturally occur in company names, whilst others are used to separated the companies.

The issue I now have is that the line Range("A1538:C1538").Select is an absolute rather than selecting the 3 cells to the left of the search return using my newly added variant.

For example, from here if my search returned a value for cell D1420, I would like to copy A1420:C1420 and paste the values to the B2:D2 on the "Ultimate Output" sheet.

Hopefully the objective is clearer now.

Sub Macro7()
'
' Macro7 Macro
'

'
Application.ScreenUpdating = False
Do While Trim(Sheets("Ultimate Output").Range("A2").Value) <> ""
Range("A2").Copy
Dim SearchVal As Variant
SearchVal = Range("A2").Value
Sheets("Raw Data").Select
Columns("D:D").Select
Selection.Find(What:=SearchVal, After:=ActiveCell, LookIn:= _
xlFormulas2, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Activate
Range("A1538:C1538").Select
Range("C1538").Activate
Application.CutCopyMode = False
Selection.Copy
Sheets("Ultimate Output").Select
Range("B2").Select
ActiveSheet.Paste
Range("A2:D2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Ultimate Output (2)").Select
Range("A2").Select
ActiveSheet.Paste
Rows("2:2").Select
Application.CutCopyMode = False
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Sheets("Ultimate Output").Select
Rows("2:2").Select
Selection.Delete Shift:=xlUp
Range("A1").Select
Loop
Application.ScreenUpdating = True
End Sub

 

[SunnyAlv]

Sheets("Ultimate Output").Select
Range("B2").Select
ActiveSheet.Paste

here u paste the value

Sheets("Ultimate Output").Select
Rows("2:2").Select
Selection.Delete Shift:=xlUp

and here u delete the value

so try this

Sub michaeljamesellis()

Dim r As Range
Dim val As Variant
Dim ws, ws1, ws2 As Worksheet


Set ws = ThisWorkbook.Sheets("Raw Data")
Set ws2 = ThisWorkbook.Sheets("Ultimate Output")
Set ws3 = ThisWorkbook.Sheets("Ultimate Output (2)")
val = Range("A2").Value


For Each r In ws.Range("D:D")

    If r.Value = val Then

        r.Offset(, -3).Resize(Selection.Rows.Count, Selection.Columns.Count + 2).Copy ws2.Range("B2")
        ws2.Range("A2:D2").Copy ws3.Range("A2")
        ws3.Rows("2:2").Insert (xlDown)
        
'/use code below to delete rows 2:2 in Sheets("Ultimate Output")
        'ws2.Rows("2:2").Delete Shift:=xlUp
      
    End If
    
Next

MsgBox "Done"

End Sub

 

[rlv01]

Dim ws, ws1, ws2 As Worksheet

@SunnyAlv in the above, ws and ws1 will be defined as type Variant, while ws2 will be defined as type Worksheet. For them all to be type Worksheet, they have to be declared like this:

Dim ws As Worksheet, ws1 As Worksheet, ws2 As Worksheet

 

[rlv01]

using my newly added variant.

SearchVal = Range("A2").Value

Which of your three worksheets contains the SearchVal in Cell A2?