Change formulas to macro to create report

[Maklil]

Hi
I need to change any formula to macro.
I want merging amount in column G or E under headers are matching with column D for each sheet .
in column A will be sheet names under cell(C4) and from B4:H4 should match for column D for each sheet and should merge amounts , if the cells B3,C3 are empty and if the cells B3,C3 contain DATES then will just merge amounts locates between two dates. I posted the result in REPORT sheet for two condition (two dates or not) from row5
and should be clear data from B5:H110 when brings data
when merge amounts for BUYING,SELLING,RESTTR,RESSR sheets are existed in column G . as the others sheets should sum for column E
my real data about 12000 rows for each sheet
Dropbox

thanks

 

[Maklil]

Bump

 

[Maklil]

posted another forum
Change formulas to macro to create report

 

[kvsrinivasamurthy]

Try .

Sub FormulasToVba()
Dim shts, hdrs, A, G, R, T, sh, H
Dim st&, nd&, Ro&, clm&, CaseClm&, BalClm&
With Sheets("REPORT")
st = .Range("B3"): If .Range("C3") = "" Then nd = 9 ^ 9 Else nd = .Range("c3")
shts = .Range("A5:A10"): hdrs = .Range("B4:H4")
ReDim R(1 To UBound(shts, 1), 1 To UBound(hdrs, 2)) As Double
For Each sh In shts
Ro = Ro + 1: clm = 0
CaseClm = WorksheetFunction.Match("CASE", Sheets(sh).Range("A1:Z1"), 0)
BalClm = WorksheetFunction.Match("BALANCE", Sheets(sh).Range("A1:Z1"), 0)
    For Each H In hdrs
    clm = clm + 1
    A = Sheets(sh).Range("A1").CurrentRegion
        For T = 2 To UBound(A, 1)
        If A(T, 1) >= st And A(T, 1) <= nd And A(T, 1) <> "TOTAL" And InStr(1, A(T, CaseClm), H) > 0 Then
        R(Ro, clm) = R(Ro, clm) + A(T, BalClm)
        End If
        Next T
    Next H
Next sh
.Range("B5:H10") = R
End With

End Sub

 

[Maklil]

Hi
I'm not really sure why show errors when merge !
for instance :
PAID for SELLING sheet when there is no dates in B3,C3 will give 64,584,306.00 based on your code
but the right will be 13,838,180.00 .
I hope to check that soon.

 

[kvsrinivasamurthy]

Try.

Sub FormulasToVba()
Dim shts, hdrs, A, G, R, T, sh, H
Dim st&, nd&, Ro&, clm&, CaseClm&, BalClm&
With Sheets("REPORT")
st = .Range("B3"): If .Range("C3") = "" Then nd = 9 ^ 9 Else nd = .Range("c3")
shts = .Range("A5:A10"): hdrs = .Range("B4:H4")
ReDim R(1 To UBound(shts, 1), 1 To UBound(hdrs, 2)) As Double
For Each sh In shts
Ro = Ro + 1: clm = 0
CaseClm = WorksheetFunction.Match("CASE", Sheets(sh).Range("A1:Z1"), 0)
BalClm = WorksheetFunction.Match("BALANCE", Sheets(sh).Range("A1:Z1"), 0)
    For Each H In hdrs
    clm = clm + 1
    A = Sheets(sh).Range("A1").CurrentRegion
        For T = 2 To UBound(A, 1)
        If A(T, 1) >= st And A(T, 1) <= nd And A(T, 1) <> "TOTAL" Then
            If (H = "PAID" And A(T, CaseClm) = "PAID") Or (H = "NOT PAID" And A(T, CaseClm) = "NOT PAID") Or (H <> "PAID" And H <> "NOT PAID" And InStr(1, A(T, CaseClm), H) > 0) Then
            R(Ro, clm) = R(Ro, clm) + A(T, BalClm)
            End If
        End If
        Next T
    Next H
Next sh
.Range("B5:H10") = R
End With

End Sub

 

[Maklil]

thank you so much.