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

 

[Akuini]

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

I can't download the file because I have to sign in.

 

[Skhande2]

Try this

Download worked.xlsx (53.07 KB) now. Fast and easy at workupload.com

Download worked.xlsx (53.07 KB) now. Fast and easy at workupload.com

workupload.com

 

[Akuini]

I've downloaded your last file.
My code searchs in col D for 'Operation Costs of Item' then 'Total Operation Costs' below it. But you last sample isn't consistent, some parts doesn't have 'Total Operation Costs', that's why the code didn't work.
I still can't figure out how to adjust the code to deal with that inconsistency.
Perhaps somebody will be able to help.

 

[Akuini]

Ok, maybe this :

Sub Skhande2_3()

'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, va


Application.ScreenUpdating = False

With Range("D1", Cells(Rows.Count, "D").End(xlUp))
    va = .Value

    Set c = .Find(What:="Operation Costs of Item", LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
    SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
         
        If Not c Is Nothing Then
            sAddress = c.Address
            
            Do
                Set c = .FindNext(c)
    
                       h = InStr(c, ":")
                       
                       tx = Trim(Mid(c, h + 1))
                       Arx = Split(tx, "   ")
                       
                       w = c.Row + 5
                       For i = w To UBound(va, 1)
                           If Not IsNumeric(va(i, 1)) Or va(i, 1) = "" Then Exit For
                       Next
                       
                       p = i - 1
    
                       Set rg = Range("A" & w & ":A" & p)
    
                       rg.Value = c.Offset(, -1)
                       rg.Offset(, 1) = Arx(0)
                       rg.Offset(, 2) = Arx(UBound(Arx))
       
               
            Loop While Not c Is Nothing And c.Address <> sAddress
        End If
    
End With

 Application.ScreenUpdating = True

End Sub

 

[Skhande2]

That works! Thanks :D

 

[Akuini]

You're welcome, glad to help & thanks for the feedback.