Find and match header in different location for the column based on sheet name

O

Omar M

Board Regular
Joined
Jan 11, 2024
Messages
66
Office Version
  1. 2019
Platform
  1. Windows
Hello,
I would macro for search BALANCE word in different location for each sheet.
so the BALANCE column will not be in the same location for each sheet .
should extract date(today) in column A , sheet name in column B and the last amount is existed in BALANCE column for each sheet as I did in BALANCES sheet.
the data for each sheet will be more about 9000 rows for each sheet also I will add more new sheets before BALANCES sheet. so the macro should deal with sheets are just before BALANCES sheet .
OMRA.xlsm
ABCD
1DATEDEBITCREDITBALANCE
211/03/20241,000.001,000.00
312/03/20242,000.003,000.00
413/03/20241,000.002,000.00
514/03/2024500.002,500.00
615/03/2024100.002,600.00
716/03/2024600.002,000.00
8TOTAL3,600.001,600.002,000.00
OMAR
Cell Formulas
RangeFormula
B8:C8B8=SUM(B2:B7)
D8D8=B8-C8




OMRA.xlsm
ABCD
1DATEDEBITCREDITBALANCE
212/03/20241,000.00-1,000.00
313/03/20244,000.00-5,000.00
414/03/20241,000.00-6,000.00
514/03/20241,000.00-5,000.00
615/03/20243,000.00-2,000.00
7TOTAL4,000.006,000.00-2,000.00
OMRAN
Cell Formulas
RangeFormula
B7:C7B7=SUM(B2:B6)
D7D7=B7-C7



OMRA.xlsm
ABCDE
1ITEMIDQTYUNIT PRICEBALANCE
21ERT555200.001,200.00240,000.00
32ERT556890.00600.00534,000.00
43ERT557200.00120.0024,000.00
54ERT558100.00250.0025,000.00
65ERT559150.00300.0045,000.00
7TOTAL868,000.00
STOCK
Cell Formulas
RangeFormula
E2:E6E2=C2*D2
E7E7=SUM(E2:E6)



OMRA.xlsm
ABC
1ITEMDETAILSBALANCE
21SAFE200,000.00
32BANK1300,000.00
43BANK2400,000.00
5TOTAL900,000.00
SAFES
Cell Formulas
RangeFormula
C5C5=SUM(C2:C4)




OMRA.xlsm
ABC
1DATEDETAILESBALANCE
2
3
4
5
6
7
8
9
10
11
12
13
BALANCES



RESULT with create formatting and borders
OMRA.xlsm
ABC
1DATEDETAILESBALANCE
226/10/2024OMAR2,000.00
326/10/2024OMRAN-2,000.00
426/10/2024STOCK868,000.00
526/10/2024SAFES900,000.00
6TOTAL1,768,000.00
BALANCES
Cell Formulas
RangeFormula
C6C6=SUM(C2:C5)


I hope finding macro to do that.
thanks
 

Excel Facts

Who is Mr Spreadsheet?
Author John Walkenbach was Mr Spreadsheet until his retirement in June 2019.
Sort by date Sort by votes
Try:

VBA Code: 
Sub MakeBalance()
  Dim sh As Worksheet, shB As Worksheet
  Dim f As Range
  Dim lr As Long
  
  Application.ScreenUpdating = False
  Set shB = Sheets("BALANCE")
  shB.Range("A2:C" & Rows.Count).Clear
  
  For Each sh In Sheets
    If sh.Name <> shB.Name Then
      Set f = sh.Rows(1).Find("BALANCE", , xlValues, xlWhole, , , False)
      If Not f Is Nothing Then
        shB.Range("A" & Rows.Count).End(3)(2).Resize(1, 3).Value = _
          Array(Date, sh.Name, f.Cells(Rows.Count).End(3).Value)
      End If
    End If
  Next
  lr = shB.Range("A" & Rows.Count).End(3).Row + 1
  shB.Range("A" & lr).Resize(1, 3).Value = _
    Array("TOTAL", , "=SUM(C2:C" & lr - 1 & ")")
    
  shB.Range("A2:C" & lr).Borders.LineStyle = xlContinuous
  shB.Range("A" & lr).Font.Bold = True
  shB.Range("C:C").NumberFormat = "#,##0.00;-#,##0.00;0"
  Application.ScreenUpdating = True
End Sub

For the format of 0 in the BALANCE column, change "0.00" to the format you want, it can be:
shB.Range("C:C").NumberFormat = "#,##0.00;-#,##0.00;0"​
shB.Range("C:C").NumberFormat = "#,##0.00;-#,##0.00;-"​
shB.Range("C:C").NumberFormat = "#,##0.00;-#,##0.00;"​

;)
 
Last edited:
Upvote 0
Try this code.
VBA Code: 
Sub UpdateBalanceSheet()
Dim sh As Worksheet
Dim M, Lr&, Ro&
Application.ScreenUpdating = False
With Sheets("BALANCES")
.Range("A1").CurrentRegion.Clear
.Range("A1:C1") = Array("DATE", "DATAILS", "BALANCE")
End With
For Each sh In Worksheets
If sh.Name <> "BALANCES" Then
Lr = sh.Range("A" & Rows.Count).End(xlUp).Row
'S = sh.Name & "A2:A" & Lr
M = Filter(Evaluate("transpose(IF('" & sh.Name & "'!A2:A" & Lr & "=Today(),'" & sh.Name & "'!D2:D" & Lr & ",false))"), False, False)

If UBound(M) >= 0 Then
With Sheets("BALANCES")
Ro = .Range("A" & Rows.Count).End(xlUp).Row + 1
.Range("A" & Ro & ":A" & Ro + UBound(M)) = Date
.Range("B" & Ro & ":B" & Ro + UBound(M)) = sh.Name
.Range("C" & Ro & ":C" & Ro + UBound(M)) = WorksheetFunction.Transpose(M)
End With
End If
M = ""
End If
Next sh

With Sheets("BALANCES")
.Range("A" & Ro + 2) = "TOTAL"
.Range("C" & Ro + 2).Formula = "=Sum(C2:C" & Ro + 1 & ")"
.Range("A1").CurrentRegion.Borders.LineStyle = xlContinuous
End With

Application.ScreenUpdating = True
End Sub
 
Upvote 0
A small detail, the name of the sheet is "BALANCES".

Adjust this in the macro:

Set shB = Sheets("BALANCES")

Code complete:
VBA Code: 
Sub MakeBalance()
  Dim sh As Worksheet, shB As Worksheet
  Dim f As Range
  Dim lr As Long
  
  Application.ScreenUpdating = False
  Set shB = Sheets("BALANCES")
  shB.Range("A2:C" & Rows.Count).Clear
  
  For Each sh In Sheets
    If sh.Name <> shB.Name Then
      Set f = sh.Rows(1).Find("BALANCE", , xlValues, xlWhole, , , False)
      If Not f Is Nothing Then
        shB.Range("A" & Rows.Count).End(3)(2).Resize(1, 3).Value = _
          Array(Date, sh.Name, f.Cells(Rows.Count).End(3).Value)
      End If
    End If
  Next
  
  lr = shB.Range("A" & Rows.Count).End(3).Row + 1
  shB.Range("A" & lr).Resize(1, 3).Value = Array("TOTAL", , "=SUM(C2:C" & lr - 1 & ")")
  shB.Range("A2:C" & lr).Borders.LineStyle = xlContinuous
  shB.Range("A" & lr).Font.Bold = True
  shB.Range("C:C").NumberFormat = "#,##0.00;-#,##0.00;0"
  Application.ScreenUpdating = True
End Sub

😅
 
Upvote 0
Try. Modified code.
VBA Code: 
Sub UpdateBalanceSheet()
Dim sh As Worksheet
Dim M, Lr&, Ro&, S$
Application.ScreenUpdating = False
With Sheets("BALANCES")
.Range("A1").CurrentRegion.Clear
.Range("A1:C1") = Array("DATE", "DATAILS", "BALANCE")
End With
For Each sh In Worksheets
If sh.Name <> "BALANCES" Then
Lr = sh.Range("A" & Rows.Count).End(xlUp).Row
S = Left(sh.Cells.Find("BALANCE").Address, 2)
M = Filter(Evaluate("transpose(IF('" & sh.Name & "'!A2:A" & Lr & "=Today(),'" & sh.Name & "'!" & S & "2:" & S & Lr & ",false))"), False, False)

If UBound(M) >= 0 Then
With Sheets("BALANCES")
Ro = .Range("A" & Rows.Count).End(xlUp).Row + 1
.Range("A" & Ro & ":A" & Ro + UBound(M)) = Date
.Range("B" & Ro & ":B" & Ro + UBound(M)) = sh.Name
.Range("C" & Ro & ":C" & Ro + UBound(M)) = WorksheetFunction.Transpose(M)
End With
End If
M = ""
End If
Next sh

With Sheets("BALANCES")
.Range("A" & Ro + 2) = "TOTAL"
.Range("C" & Ro + 2).Formula = "=Sum(C2:C" & Ro + 1 & ")"
.Range("A1").CurrentRegion.Borders.LineStyle = xlContinuous
.Range("A1:C1").EntireColumn.AutoFit
End With

Application.ScreenUpdating = True
End Sub
 
Upvote 0
it's perfect , Dante!

but I said
so the macro should deal with sheets are just before BALANCES sheet
Click to expand...
meaning ignore any sheet after BALANCES sheet.so I don't want implementation after BALANCES sheet .
my you fix it ,please?
 
Last edited:
Upvote 0
Omar M said:
meaning ignore any sheet after BALANCES sheet
Click to expand...
In the future, it would be more precise if you commented that after that sheet there are more sheets. I can't guess everything.

Omar M said:
my you fix it ,please?
Click to expand...
Of course, try:

VBA Code: 
Sub MakeBalance()
  Dim sh As Worksheet, shB As Worksheet
  Dim f As Range
  Dim lr As Long
  
  Application.ScreenUpdating = False
  Set shB = Sheets("BALANCES")
  shB.Range("A2:C" & Rows.Count).Clear
  
  For Each sh In Sheets
    If sh.Name = shB.Name Then Exit For
    Set f = sh.Rows(1).Find("BALANCE", , xlValues, xlWhole, , , False)
    If Not f Is Nothing Then
      shB.Range("A" & Rows.Count).End(3)(2).Resize(1, 3).Value = _
        Array(Date, sh.Name, f.Cells(Rows.Count).End(3).Value)
    End If
  Next
  
  lr = shB.Range("A" & Rows.Count).End(3).Row + 1
  shB.Range("A" & lr).Resize(1, 3).Value = Array("TOTAL", , "=SUM(C2:C" & lr - 1 & ")")
  shB.Range("A2:C" & lr).Borders.LineStyle = xlContinuous
  shB.Range("A" & lr).Font.Bold = True
  shB.Range("C:C").NumberFormat = "#,##0.00;-#,##0.00;0"
  Application.ScreenUpdating = True
End Sub

😇
 
Upvote 0
Solution
You must log in or register to reply here.

Similar threads

A
  • Solved
add formulas in last column after sorting for each duplicates ID
Replies
9
Views
126
Peter_SSs
Peter_SSs
M
  • Solved
move and delete rows contains minus and positive value from range to another
Replies
8
Views
80
Mussa
M
A
  • Solved
Delete customer if contains the same amount otherwise just subtract between two sheets
2
Replies
15
Views
395
igold
igold
E
  • Solved
Find a value matching a range upon several criteria
Replies
2
Views
166
ED38
E
A
  • Solved
Compare two sheets based on lastrow with highlighted cells
2 3
Replies
26
Views
254
mumps
mumps

Forum statistics

Threads
1,223,888
Messages
6,175,207
Members
452,618
Latest member
Tam84

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top