Macro to handle big data

[Skhande2]

A macro that starts at the top searches for whichever cell starts with 'Operation Costs of Item'. Once found, it then copies the number located 1 cell to its left and pastes it 5 rows below that number in column A. And in column B and C of that row just pasted into, content after ' Operation Costs of Item : ' are split into column B and C based on more than 2 spaces between them. There should be a number to the right of the cell that was just pasted on (in column D). It continues to copy and paste the 3 cells values just filled in column A, B and C till the list of numbers to its right ends. It then works it way down and repeats this mechanism for every 'Operation Costs of Item' found. Ensure that values in other cells untouched aren't removed. ThanksIn the link, there are 2 excel sheets to show before and after. Thanks!

https://www.file.io/lqXc/download/mz6wdvfzb44o

 

[Skhande2]

Actually this picture is probably a better indicator

 

[Akuini]

@Skhande2
Try this:

Sub Skhande2_1()

'Operation Costs of Item
' Total Operation Costs

Dim i As Long, j As Long, n As Long, h As Long, w As Long, p As Long
Dim c As Range, f As Range, rg As Range
Dim tx As String, Adr As String
Dim Arx


Application.ScreenUpdating = False

With Range("D1", Cells(Rows.Count, "D").End(xlUp))
        Set f = .Find(What:="Total Operation Costs", LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
                        SearchDirection:=xlPrevious, MatchCase:=False, SearchFormat:=False)
        Adr = f.Address
        Set f = Range("D1")
    Do
    
    Set c = .Find(What:="Operation Costs of Item", After:=f, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
    SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
         
'                Debug.Print "c" & " : " & c.Address
               Set f = .Find(What:="Total Operation Costs", After:=c, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
                        SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
                        If Not f Is Nothing Then
'                            Debug.Print "F" & " : " & f.Address
                            h = InStr(c, ":")
                            
                            tx = Trim(Mid(c, h + 1))
                            Arx = Split(tx, "   ")
                            
                            w = c.Row + 5
                            p = f.Row - 2

                            Set rg = Range("A" & w & ":A" & p)

                            rg.Value = c.Offset(, -1)
                            rg.Offset(, 1) = Arx(0)
                            rg.Offset(, 2) = Arx(UBound(Arx))
                        End If
   
                  Set c = f
           
        Loop While Not f.Address = Adr
    
End With

 Application.ScreenUpdating = True

End Sub

 

[Skhande2]

That works! Thanks

 

[Akuini]

Glad it works.
But we need a little tweak, because the result in col C might have space in the beginning. Use this one:

Sub Skhande2_2()

'Operation Costs of Item
' Total Operation Costs

Dim i As Long, j As Long, n As Long, h As Long, w As Long, p As Long
Dim c As Range, f As Range, rg As Range
Dim tx As String, Adr As String
Dim Arx

Application.ScreenUpdating = False

With Range("D1", Cells(Rows.Count, "D").End(xlUp))
        Set f = .Find(What:="Total Operation Costs", LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
                        SearchDirection:=xlPrevious, MatchCase:=False, SearchFormat:=False)
        Adr = f.Address
        Set f = Range("D1")
    Do
    
    Set c = .Find(What:="Operation Costs of Item", After:=f, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
    SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
         
'                Debug.Print "c" & " : " & c.Address
               Set f = .Find(What:="Total Operation Costs", After:=c, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
                        SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
                        If Not f Is Nothing Then
'                            Debug.Print "F" & " : " & f.Address
                            h = InStr(c, ":")
                            
                            tx = Trim(Mid(c, h + 1))
                            Arx = Split(tx, "   ")
                            
                            w = c.Row + 5
                            p = f.Row - 2

                            Set rg = Range("A" & w & ":A" & p)

                            rg.Value = c.Offset(, -1)
                            rg.Offset(, 1) = Trim(Arx(0))
                            rg.Offset(, 2) = Trim(Arx(UBound(Arx)))
                        End If
   
                  Set c = f
           
        Loop While Not f.Address = Adr
    
End With

 Application.ScreenUpdating = True
End Sub

 

[Skhande2]

Thanks, so I tried testing it on different files and it bugged out on this one...

https://file.io/wUTkFABIm7Xe

 

[Akuini]

Thanks, so I tried testing it on different files and it bugged out on this one...

https://file.io/wUTkFABIm7Xe

The file is deleted.

 

[Rick Rothstein]

The file is deleted.

I got this warning from my Norton anti-virus when I clicked that link...

 

[RoryA]

Welcome to the MrExcel Message Board!

Cross-posting (posting the same question in more than one forum) is not against our rules, but the method of doing so is covered by #13 of the Forum Rules.

Be sure to follow & read the link at the end of the rule too!

Cross posted at:

Macro to handle big data

A macro that starts at the top searches for whichever cell starts with 'Operation Costs of Item'. Once found, it then copies the number located 1 cell to its left and pastes it 5 rows below that number in column A. And in column B and C of that row just pasted into, content after ' Operation...

www.excelforum.com

There is no need to repeat the link(s) provided above but if you have posted the question at other places, please provide links to those as well.

If you do cross-post in the future and also provide links, then there shouldn’t be a problem.

 

[Skhande2]

Sorry about not following the rules and the wrong link. Here is a different site, this should work: My files - UploadNow.io