I am trying to make a macro that reads data from an excel spreadsheet and then makes a table that will make use of the data read in from the excel spreadsheet.
To be more precise, I need to search through one column for certain numbers that represent account numbers (i.e. 130, 151, 140, etc...). For each account number found, the macro should read in the $ value pertaining to that account number which is located 1 column to the left (i.e. N4 contains 155, then M4 contains the associated $ amount). As it continues to find account numbers it needs to total all the $ associated with each account number. Also it must keep track of how many different accounts are present in the excel spreadsheet.
I am re-using code previously made from somebody before me, but I'm not 100% sure how it works. When I run this, I cannot test to see if it is working, because I don't know the code to have VBA "print" the value of a variable into a cell so I can see what that variable contains after the macro runs. The code I have is as follows, can somebody verify this should work and please teach me how to print the value of the variable into a given cell? Thank you,
**begin quote
'Search in each array for matches, write the corresponding account number in the account number column
'add subtotals for each sub account numbers and get counts for each sub account item.
Dim cell As Range, rng As Range
Set rng = Intersect(Range("F:F"), ActiveSheet.UsedRange)
For Each cell In rng
cellnumi = cellnum
'Search for Account 130
If InStr(1, cell, "130", 1) Then
If cellnumi <= cellnum Then
tot130 = tot130 + cell.Offset(0, -1)
cellnumi = cellnumi + 1
Cnt130 = Cnt130 + 1
End If
End If
'Search for Account 140
If InStr(1, cell, "140", 1) Then
If cellnumi <= cellnum Then
tot140 = tot140 + cell.Offset(0, -1)
cellnumi = cellnumi + 1
Cnt140 = Cnt140 + 1
End If
End If
'Search for Account 151
If InStr(1, cell, "151", 1) Then
If cellnumi <= cellnum Then
tot151 = tot151 + cell.Offset(0, -1)
cellnumi = cellnumi + 1
Cnt151 = Cnt151 + 1
End If
End If
If cell.Offset(0, q + 1) = "" Then
cell.Offset(0, s) = ("-")
End If
If cell.Offset(0, q).Interior.ColorIndex = 6 Then
cell.Offset(0, s).ClearContents
End If
'Find total value and store it.
sortcell = "P" & p
Range(sortcell).Select
mattotal = ActiveCell.value
xxx = p
'Sort account numbers and costs
p = p - 1
sortcell = "A2:Q" & p
Range(sortcell).Sort Key1:=Range("P2"), Order1:=xlDescending
Range(sortcell).Sort Key1:=Range("Q2"), Order1:=xlAscending
'Declare Variables
p = 0
s = 0
q = 0
'Get count of account numbers found to find percentages
If Cnt130 > 0 Then
AcctCnt = AcctCnt + 1
End If
If Cnt140 > 0 Then
AcctCnt = AcctCnt + 1
End If
If Cnt151 > 0 Then
AcctCnt = AcctCnt + 1
End If
**end quote
instead of searching one column I believe this code searches the entire spreadsheet for account numbers (I'd like to change this to just search one column)
As mentioned, I am merely editing previously existing code. I have only a faint idea of how it works as I have no VBA programming experience. I was able to get the variables to display in the excel file but they contain the value 0 and I know this isn't right. So the variables are not accumulating as I want them to. Does the code look right?
Should it rather be written
tot130 = tot130 + cell.Offset(0, -1).value
and I want to range the O column, so I changed the code to say ("O:O")
That did not work. Here is how my code looks now, the changes have been put in bold.
[VBA]
'Search in each array for matches, write the corresponding account number in the account number column
'add subtotals for each sub account numbers and get counts for each sub account item.
Dim tot151 As Long
Dim Cnt151 As Long
Dim cell As Variant, rng As Range
Set rng = Intersect(Range("O:O"), ActiveSheet.UsedRange)
For Each cell In rng
cellnumi = cellnum
'Search for Account 130
If InStr(1, cell, "130", 1) Then
If cellnumi <= cellnum Then
tot130 = tot130 + cell.Offset(0, -1).value
cellnumi = cellnumi + 1
Cnt130 = Cnt130 + 1
End If
End If
'Search for Account 140
If InStr(1, cell, "140", 1) Then
If cellnumi <= cellnum Then
tot140 = tot140 + cell.Offset(0, -1).value
cellnumi = cellnumi + 1
Cnt140 = Cnt140 + 1
End If
End If
'Search for Account 151
If InStr(1, cell, "151", 1) Then
If cellnumi <= cellnum Then
tot151 = tot151 + cell.Offset(0, -1).value
cellnumi = cellnumi + 1
Cnt151 = Cnt151 + 1
End If
End If
If cell.Offset(0, q + 1) = "" Then
cell.Offset(0, s) = ("-")
End If
If cell.Offset(0, q).Interior.ColorIndex = 6 Then
cell.Offset(0, s).ClearContents
End If
Scroll over to columns N and O. I need it too look at the account numbers in column O and find the total sum of money applied to each account. Then I want it to print these values in a cell value. For test purposes I've selected it to print to cell A50 and A51.
[VBA]Sub SubTotal_Accounts()
Dim acctRng As Range, cell As Range
Dim i As Long, ct151 As Long, ct130 As Long
Dim st151 As Long, st130 As Long
ActiveWorkbook.Sheets(1).Activate
Range("A1").Activate
Set acctRng = ActiveSheet.Range("O:O")
For Each cell In acctRng
If cell.Row <> 1 Then
Next cell
ActiveWorkbook.Sheets(1).Range("A50").Value = st151
ActiveWorkbook.Sheets(1).Range("B50").Value = ct151
ActiveWorkbook.Sheets(1).Range("A51").Value = st130
ActiveWorkbook.Sheets(1).Range("B51").Value = ct130
End Sub[/VBA]
I kind of scrapped your structure a little bit, if you need help getting this into the program you already have i can do that but this works for me (in the sample data set the subtotals are:
151 ($14143.12 total, 17 count)
130 ($126.62 total, 14 count)
Reply With Quote
happy coding