How gather data from the middle of the sheet?

M

mtbthepro

Board Regular
Joined
Feb 22, 2017
Messages
91
Hello,
This code needs to locate the Department63's account total and transfer it to designated row in another sheet. The problem I am having is the macro not being able to locate Department63's account total which is located between Department 60 and 65. The macro can locate Dept 60 and 65's account total and transfer it but doesn't find account total for Dept63.

Account total is always in ColumnB and the data is always from Column D to H.

Code: 
Sub NumberTrans_Dep60()Dim nlast As Long
Dim sht As Worksheet
Dim n As Integer


Sheets("Amanda").Activate
Set sht = ActiveWorkbook.ActiveSheet
nlast = Cells(Rows.Count, "B").End(xlUp).Row
                    
For n = nlast To 1 Step -1
If sht.Cells(n, 1).Value = "Department 60   Adult Program Department" Then
  ElseIf sht.Cells(n, 2).Value = "ACCOUNT TOTAL" Then
   Range(Cells(n, "D"), Cells(n, "H")).Copy
   Sheets("AR SUMMARY").Range("C19").PasteSpecial xlPasteValues


  End If
Next n
End Sub




Sub NumberTrans_Dep63()
Dim nlast As Long
Dim sht As Worksheet
Dim n As Integer


Sheets("Amanda").Activate
Set sht = ActiveWorkbook.ActiveSheet
nlast = Cells(Rows.Count, "B").End(xlUp).Row


For n = nlast To 1 Step -1
If sht.Cells(n, 1).Value = "Department 63   Writers'Voice NatlDept" Then
  ElseIf sht.Cells(n, 2).Value = "ACCOUNT TOTAL" Then
   Range(Cells(n, "D"), Cells(n, "H")).Copy
   Sheets("AR SUMMARY").Range("C20").PasteSpecial xlPasteValues


  End If
Next n
End Sub


Sub NumberTrans_Dep65()
Dim nlast As Long
Dim sht As Worksheet
Dim n As Integer


Sheets("Amanda").Activate
Set sht = ActiveWorkbook.ActiveSheet
nlast = Cells(Rows.Count, "B").End(xlUp).Row
For n = nlast To 1 Step -1
If sht.Cells(n, 1).Value = "Department 65   Visual and Performing Art" Then
  ElseIf sht.Cells(n, 2).Value = "ACCOUNT TOTAL" Then
   Range(Cells(n, "D"), Cells(n, "H")).Copy
   Sheets("AR SUMMARY").Range("C21").PasteSpecial xlPasteValues
  Exit For
  End If
Next n
End Sub
 
Sort by date Sort by votes

Excel Facts

Pivot Table Drill Down
Double-click any number in a pivot table to create a new report showing all detail rows that make up that number
mtbthepro said:
Yes sure, how can I contact you?
Click to expand...

You can PM me but with one proviso and that is that I don't provide solutions through that route as I feel it against the principles of the forum.

Solutions produced via the forum should be there for others to learn from.
 
Upvote 0
I agree with you, I will just try to explain what I need and it will be just one proviso. Do I have your permission lol?
 
Upvote 0
Hi there,
This sheet below is a sheet within a workbook with many sheets like this one. The formatting of the sheets will always remain the same. The code works great for what I first asked for but then a change occured. The code, should read everything the same way but add an if statement for a grand total. Some sheets have grand totals and some do not. If there are no grand totals in column c then go on and read for account total. If grand total is found transfer the grandtotal and move to the next department macro.


Example of a sheet
[TABLE="width: 986"]
<tbody>[TR]
[TD="colspan: 3"]Department 60 Adult Program Department[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="colspan: 2"]ACCOUNT#: 1-026-60-00000-3344[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]MEMBER NUMBER[/TD]
[TD]MEMBER NAME[/TD]
[TD]TRN DATE[/TD]
[TD]0 -30 DAYS[/TD]
[TD]31-60 DAYS[/TD]
[TD]61-90 DAYS[/TD]
[TD]OVER 90 DAYS[/TD]
[TD]PAST DUE[/TD]
[/TR]
[TR]
[TD]026-000175813-02[/TD]
[TD]Brea, Hanna[/TD]
[TD="align: right"]1/3/2017[/TD]
[TD="align: right"]$0.00[/TD]
[TD="align: right"]$0.00[/TD]
[TD="align: right"]$0.00[/TD]
[TD="align: right"]$325.00[/TD]
[TD="align: right"]$325.00[/TD]
[/TR]
[TR]
[TD]026-000144629-02[/TD]
[TD]Garrelick, Jillia[/TD]
[TD="align: right"]1/18/2017[/TD]
[TD="align: right"]$0.00[/TD]
[TD="align: right"]$0.00[/TD]
[TD="align: right"]$0.00[/TD]
[TD="align: right"]$425.00[/TD]
[TD="align: right"]$425.00[/TD]
[/TR]
[TR]
[TD]026-000144629-03[/TD]
[TD]Garrelick, Lilah[/TD]
[TD="align: right"]1/18/2017[/TD]
[TD="align: right"]$425.00[/TD]
[TD="align: right"]$0.00[/TD]
[TD="align: right"]$0.00[/TD]
[TD="align: right"]$0.00[/TD]
[TD="align: right"]$425.00[/TD]
[/TR]
[TR]
[TD]026-000087880-02[/TD]
[TD]Roque, Kaiden[/TD]
[TD="align: right"]12/19/2016[/TD]
[TD="align: right"]$0.00[/TD]
[TD="align: right"]$0.00[/TD]
[TD="align: right"]$0.00[/TD]
[TD="align: right"]$775.00[/TD]
[TD="align: right"]$775.00[/TD]
[/TR]
[TR]
[TD]026-000087880-03[/TD]
[TD]Roque, Kelsey[/TD]
[TD="align: right"]12/19/2016[/TD]
[TD="align: right"]$0.00[/TD]
[TD="align: right"]$775.00[/TD]
[TD="align: right"]$0.00[/TD]
[TD="align: right"]$0.00[/TD]
[TD="align: right"]$775.00[/TD]
[/TR]
[TR]
[TD]026-000087880-03[/TD]
[TD]Roque, Kelsey[/TD]
[TD="align: right"]12/19/2016[/TD]
[TD="align: right"]$0.00[/TD]
[TD="align: right"]$1,230.00[/TD]
[TD="align: right"]$0.00[/TD]
[TD="align: right"]$0.00[/TD]
[TD="align: right"]$1,230.00[/TD]
[/TR]
[TR]
[TD]026-000087880-03[/TD]
[TD]Roque, Kelsey[/TD]
[TD="align: right"]12/19/2016[/TD]
[TD="align: right"]$0.00[/TD]
[TD="align: right"]$0.00[/TD]
[TD="align: right"]$0.00[/TD]
[TD="align: right"]$600.00[/TD]
[TD="align: right"]$600.00[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]ACCOUNT TOTAL[/TD]
[TD][/TD]
[TD="align: right"]$425.00[/TD]
[TD="align: right"]$2,005.00[/TD]
[TD="align: right"]$0.00[/TD]
[TD="align: right"]$2,125.00[/TD]
[TD="align: right"]$4,555.00[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="colspan: 3"]Department 65 Visual and Performing Art[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="colspan: 2"]ACCOUNT#: 1-026-65-00000-3346[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]MEMBER NUMBER[/TD]
[TD]MEMBER NAME[/TD]
[TD]TRN DATE[/TD]
[TD]0 -30 DAYS[/TD]
[TD]31-60 DAYS[/TD]
[TD]61-90 DAYS[/TD]
[TD]OVER 90 DAYS[/TD]
[TD]PAST DUE[/TD]
[/TR]
[TR]
[TD]026-000173132-00[/TD]
[TD]Coursehorse inc.[/TD]
[TD="align: right"]11/4/2016[/TD]
[TD="align: right"]$0.00[/TD]
[TD="align: right"]$0.00[/TD]
[TD="align: right"]$0.00[/TD]
[TD="align: right"]$227.17[/TD]
[TD="align: right"]$227.17[/TD]
[/TR]
[TR]
[TD]026-000173132-00[/TD]
[TD]Coursehorse inc.[/TD]
[TD="align: right"]1/1/2017[/TD]
[TD="align: right"]$0.00[/TD]
[TD="align: right"]$0.00[/TD]
[TD="align: right"]$0.00[/TD]
[TD="align: right"]$209.63[/TD]
[TD="align: right"]$209.63[/TD]
[/TR]
[TR]
[TD]026-000173132-00[/TD]
[TD]Coursehorse inc.[/TD]
[TD="align: right"]1/1/2017[/TD]
[TD="align: right"]$0.00[/TD]
[TD="align: right"]$0.00[/TD]
[TD="align: right"]$0.00[/TD]
[TD="align: right"]$208.07[/TD]
[TD="align: right"]$208.07[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]ACCOUNT TOTAL[/TD]
[TD]Grand Total[/TD]
[TD="align: right"]$0.00[/TD]
[TD="align: right"]$0.00[/TD]
[TD="align: right"]$0.00[/TD]
[TD="align: right"]$644.87[/TD]
[TD="align: right"]$644.87[/TD]
[/TR]
</tbody>[/TABLE]


There are three macros that call each other but if one is called and that department is unavailable then it should jump to the next department.

Code: 
Sub NumberTrans_Dep60()
Dim nlast As Long
Dim sht As Worksheet
Dim rng1 As Range
Dim rng2 As Range
Dim AcctTotRw As Long
Dim DeptRw As Long


Sheets("Amanda").Activate
Set sht = ActiveWorkbook.ActiveSheet
nlast = Cells(Rows.Count, "B").End(xlUp).Row
clast = Cells(Rows.Count, "C").End(xlUp).Row
                    
Range("A1").Activate
Set rng1 = Range("A1:A" & nlast).Find("Department 60   Adult Program Department", Cells(1, ActiveCell.Column), xlValues, xlWhole, , xlNext)
DeptRw = rng1.Row


Range("C" & DeptRw).Activate
Set rng2 = Range("C" & DeptRw & ":C" & clast).Find("GRAND TOTAL", Cells(DeptRw, ActiveCell.Column), xlValues, xlWhole, , xlNext)
AccTotRw = rng2.Row




If AccToRw <> AccToRw Then
Range("B" & DeptRw).Activate
Set rng2 = Range("B" & DeptRw & ":B" & nlast).Find("ACCOUNT TOTAL", Cells(DeptRw, ActiveCell.Column), xlValues, xlWhole, , xlNext)
AccTotRw = rng2.Row
End If


Range("D" & AccTotRw).Resize(, 5).Copy
Sheets("AR SUMMARY").Range("C35").PasteSpecial xlPasteValues


NumberTrans_Dep63
End If
End Sub


Sub NumberTrans_Dep63()
Dim nlast As Long
Dim sht As Worksheet
Dim rng1 As Range
Dim rng2 As Range
Dim AcctTotRw As Long
Dim DeptRw As Long


Sheets("Amanda").Activate
Set sht = ActiveWorkbook.ActiveSheet
nlast = Cells(Rows.Count, "B").End(xlUp).Row
clast = Cells(Rows.Count, "C").End(xlUp).Row
                    
Range("A1").Activate
Set rng1 = Range("A1:A" & nlast).Find("Department 63   Writers Voice, National Department", Cells(1, ActiveCell.Column), xlValues, xlWhole, , xlNext)
If Not rng1 Is Nothing Then
DeptRw = rng1.Row


Range("C" & DeptRw).Activate
Set rng2 = Range("C" & DeptRw & ":C" & clast).Find("GRAND TOTAL", Cells(DeptRw, ActiveCell.Column), xlValues, xlWhole, , xlNext)
AccTotRw = rng2.Row


If AccToRw <> AccToRw Then
Range("B" & DeptRw).Activate
Set rng2 = Range("B" & DeptRw & ":B" & nlast).Find("ACCOUNT TOTAL", Cells(DeptRw, ActiveCell.Column), xlValues, xlWhole, , xlNext)
AccTotRw = rng2.Row
End 


Range("D" & AccTotRw).Resize(, 5).Copy
Sheets("AR SUMMARY").Range("C36").PasteSpecial xlPasteValues
End If
NumberTrans_Dep65
End Sub


Sub NumberTrans_Dep65()
Dim nlast As Long
Dim sht As Worksheet
Dim rng1 As Range
Dim rng2 As Range
Dim AcctTotRw As Long
Dim DeptRw As Long


Sheets("Amanda").Activate
Set sht = ActiveWorkbook.ActiveSheet
nlast = Cells(Rows.Count, "B").End(xlUp).Row
clast = Cells(Rows.Count, "C").End(xlUp).Row
                    
Range("A1").Activate
Set rng1 = Range("A1:A" & nlast).Find("Department 65   Visual and Performing Art", Cells(1, ActiveCell.Column), xlValues, xlWhole, , xlNext)
If Not rng1 Is Nothing Then
DeptRw = rng1.Row


Range("C" & DeptRw).Activate
Set rng2 = Range("C" & DeptRw & ":C" & clast).Find("GRAND TOTAL", Cells(DeptRw, ActiveCell.Column), xlValues, xlWhole, , xlNext)
If Not rng2 Is Nothing Then
AccTotRw = rng2.Row


If AccToRw <> AccToRw Then
Range("B" & DeptRw).Activate
Set rng2 = Range("B" & DeptRw & ":B" & nlast).Find("ACCOUNT TOTAL", Cells(DeptRw, ActiveCell.Column), xlValues, xlWhole, , xlNext)
AccTotRw = rng2.Row
End If


Range("D" & AccTotRw).Resize(, 5).Copy
Sheets("AR SUMMARY").Range("C37").PasteSpecial xlPasteValues
End If
End If
End Sub

If you need more explanation please ask.
 
Last edited:
Upvote 0
Please confirm that :-
1, there is only one "ACCOUNT TOTAL" for each department
2, that if "GRAND TOTAL" appears for the department it is also accompanied by the "ACCOUNT TOTAL" legend in column B
3, that when "GRAND TOTAL" appears in column C it is UPPERCASE and not Mixed case.

Fyi - the way the modules are set up if you look for "GRAND TOTAL" for a department you might not get the correct one.
 
Upvote 0
Hi,
1. No, sometimes departments have multiple account totals. Then those departments receive a grand total.
2. Not sure what you mean by accompanied, If there is a grand total, it remains in column C and account total remains in column B. Account totals do not get deleted if there is a grand total.
3. It appears as "Grand total"

really, that is maybe why it is not working.
 
Upvote 0
ukmikeb said:
Please confirm that :-
1, there is only one "ACCOUNT TOTAL" for each department
2, that if "GRAND TOTAL" appears for the department it is also accompanied by the "ACCOUNT TOTAL" legend in column B
3, that when "GRAND TOTAL" appears in column C it is UPPERCASE and not Mixed case.

Fyi - the way the modules are set up if you look for "GRAND TOTAL" for a department you might not get the correct one.
Click to expand...
Hello, I just want to thank you for helping me. It was very kind of you. I figured it out completely and the macro works the way I want it to work. This is the final code for one sheet.
Thank you so much. <3
Code: 
Sub NumberTrans_Dep70()
Dim nlast As Long
Dim sht As Worksheet
Dim rng1 As Range
Dim rng2 As Range
Dim AcctTotRw As Long
Dim DeptRw As Long


Sheets("Francisca").Activate
Set sht = ActiveWorkbook.ActiveSheet
nlast = Cells(Rows.Count, "B").End(xlUp).Row
clast = Cells(Rows.Count, "C").End(xlUp).Row
                    
Range("A1").Activate
Set rng1 = Range("A1:A" & nlast).Find("Department 70 *", Cells(1, ActiveCell.Column), xlValues, xlWhole, , xlNext)


If Not rng1 Is Nothing Then
    DeptRw = rng1.Row


    Range("C" & DeptRw).Activate
    Set rng2 = Range("C" & DeptRw & ":C" & clast).Find("GRAND TOTAL", Cells(DeptRw, ActiveCell.Column), xlValues, xlWhole, , xlNext)
    If Not rng2 Is Nothing Then
    AccTotRw = rng2.Row
    
    Range("D" & AccTotRw).Resize(, 5).Copy
    Sheets("AR SUMMARY").Range("C38").PasteSpecial xlPasteValues
End If
End If


If Not rng1 Is Nothing Then
    If rng2 Is Nothing Then
    Range("B" & DeptRw).Activate
    Set rng2 = Range("B" & DeptRw & ":B" & nlast).Find("ACCOUNT TOTAL", Cells(DeptRw, ActiveCell.Column), xlValues, xlWhole, , xlNext)
    AccTotRw = rng2.Row
    Range("D" & AccTotRw).Resize(, 5).Copy
    Sheets("AR SUMMARY").Range("C38").PasteSpecial xlPasteValues
End If
End If


NumberTrans_Dep73
End Sub
 
Last edited:
Upvote 0
Hi

Perhaps you may consider this code snippet for finding the Account/Grand Totals having found a Department.

Code: 
nlast = Cells(Rows.Count, "B").End(xlUp).Row
Range("A1").Activate
Set rng1 = Range("A1:A" & nlast).Find("Department 60 *", Cells(1, ActiveCell.Column), xlValues, xlWhole, , xlNext)
DeptRw = rng1.Row
' Look for next Department legend from row below Department found above
Set rng2 = Range("A" & DeptRw + 1 & ":A" & nlast).Find("Department*", Cells(DeptRw + 1, ActiveCell.Column), xlValues, xlWhole, , xlNext)
If Not rng2 Is Nothing Then
    AcctTotRw = rng2.Row - 1 ' Another Department follows active Department and we locate the Account Totals in the row above
Else
    AcctTotRw = nlast ' We've found the last Department!!!!
End If
If Range("C" & AccTotrw).Value = "Grand Total" Then
'   do next code part 1 ie Grand Totals
Else
' do next code part 2 ie Account Totals
End If

ps I think you will find that your code is still liable to find the "Grand Total" for the wrong Department because you don't limit the range within the Department data you are focusing on.

hth
 
Upvote 0
Hi, Perhaps I will use your code and I didn't think of my code finding the wrong department "Grand total" but thank you.
 
Upvote 0
You must log in or register to reply here.

Similar threads

C
  • Solved
Need Help VBA
2
Replies
10
Views
427
Trebor76
T
A
  • Question Question
Vba code for data fetching from nseindia
Replies
0
Views
493
asp123
A
R
  • Question Question
[VBA] - Need to Hide one column and need sum of columns
Replies
0
Views
192
rsolanki
R
C
  • Solved
Copy data from multiple sheets into a master sheet - VBA button stuck
Replies
3
Views
183
NdNoviceHlp
NdNoviceHlp
VinceF
  • Solved
Code to Disregard VBA or to Execute if Condition Met
Replies
3
Views
237
Alex Blakenburg
A

Forum statistics

Threads
1,223,907
Messages
6,175,301
Members
452,633
Latest member
DougMo

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