Get row and column number of first cell in Excel table - vba

I use a lot of tables in my code
My table is somewhere in my worksheet.
I know I can go to the first cell with the following code:
Worksheets("sheet").ListObjects("table").Range.Cells(1, 1).Activate
But I would like to store the row and column number in 2 integers ie. column = 3 and row = 4 if first cell of table is C4.
Worksheets("sheet").ListObjects("table").Row and Column are not working unfortunately

This prints the row and the column of the first cell of the table:
Public Sub TestMe()
Dim tbl As ListObject
Set tbl = Worksheets(1).ListObjects("Table1")
Debug.Print tbl.Range.Cells(1, 1).Row
Debug.Print tbl.Range.Cells(1, 1).Column
'As a bonus:
Debug.Print tbl.Range.Rows.Count 'total number of rows
Debug.Print tbl.Range.Columns.Count 'total number of columns
End Sub
Very dirty way, using your code, which is activating the Cells(1,1):
Debug.Print ActiveCell.Row
Debug.Print ActiveCell.Column

You're nearly there. You need:
Worksheets("sheet").ListObjects("table").Range.Cells(1, 1).Row
... to return the absolute row number within the spreadsheet, of your table's first row.
Obviously, the same syntax to return the column number.

Related

VBA search column heading in a sheet and return SUM in another sheet

I would like to get datas from sheet 1 to sheet 2 with reference to the column headings With VBA.
For example:(EXCEL file)
So if I want to find the sum of fun1 person A with criteria 1 the command have to go and find the heading “sum of fun 1” in sheet 1 and choose the datas that are only under criteria 1 and sum it up in sheet 2 cell D5. (By using column heading reference instead of cell reference. The table range is A2 : U80. thanks.
Public Sub Match()
ThisWorkbook.Sheets("Sheet1").Activate
Range("Sheet2!B3") = Application.Sum(Application.Index(Range("A:G"), 0, Application.Match("Crit1" & "Fun1personA", Range("A2:G2"), 0)))
End Sub
I have tried it codes but it failed. i know that i havnt include the Row reference for crit1 , but iam not sure how to apply that to the formula.
Can anyone help me with this ? Thanks in advance
You could do it with a formula.
I'll assume that the table in your example covers the range A1:E10.
First we'll need to find the correct column using a MATCH formula:
=MATCH("Fun2PersonA",$1:$1,0) - this will return 3 as Fun2PersonA is in column C.
Next we need to know how many rows are in the table. Assuming the criteria in column A has no blanks except cell A1 we can use COUNTA:
=COUNTA($A:$A)+1 - this will return 10.
The above two formula will be used a few times within the final result, so will probably be easier to use helper cells to store the results (I'll just call them ColumnRef and LastRowRef for readability rather than actual cell references).
Now to set a reference to the first cell and last cell in column C.
=INDEX($1:$1,,ColumnRef) will reference the header, while =INDEX($1:$1048576,RowRef,ColumnRef) will reference the last cell.
As these can be used as references and not just values =SUM(INDEX($1:$1,,ColumnRef):INDEX($1:$1048576,RowRef,ColumnRef)) will sum everything in that column. It's the same as writing =SUM(C1:C10).
But you want to use SUMIF, so we need to reference the criteria in column A as well.
=INDEX($A:$A,RowRef) will reference the last cell in column A, so $A$1:INDEX($A:$A,RowRef) will reference all values in column A.
Final Formula:
The final step is to stick it all together into your final formula:
=SUMIF($A$1:INDEX($A:$A,RowRef),"Crit1",INDEX($1:$1,,ColumnRef):INDEX($1:$1048576,RowRef,ColumnRef))
This is the same as writing =SUMIF($A$1:$A$10,"Crit1",$C$1:$C$10)
For a VBA solution:
Public Function SumCriteria(FunPerson As String, Criteria As String) As Double
Dim rTable As Range
Dim rCol As Range
Dim rCriteria As Range
Dim LastRow As Long
Dim LastCol As Long
'Update Sheet1 to the sheet name with your table.
With ThisWorkbook.Worksheets("Sheet1")
'You may have to change how to find the last row/column depending
'on any extra data on the sheet.
LastRow = .Cells(Rows.Count, 1).End(xlUp).Row
LastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
Set rTable = .Range(.Cells(1, 1), .Cells(LastRow, LastCol))
'EDIT: You could set your table as below if it's a static size.
'Set rTable = .Range("A2:U80")
'The first statement finds the FunPerson heading
Set rCol = rTable.Rows(1).Find(What:=FunPerson, LookIn:=xlValues, LookAt:=xlWhole)
If Not rCol Is Nothing Then
SumCriteria = Application.WorksheetFunction.SumIf(rTable.Columns(1), Criteria, rTable.Columns(rCol.Column))
Else
SumCriteria = CVErr(xlErrValue)
End If
End With
End Function
This method looks at column A and row 1 to get the dimensions of the table and then uses SUMIF to count the figures.
You can use it as a worksheet formula: =SumCriteria("Fun1PersonA","Crit1")
or within VBA:
Public Sub Test()
Dim a As Double
a = SumCriteria("Fun1PersonA", "Crit1")
End Sub

VBA - IF loop improvements

I'm currently running a macro which identifies duplicates in a workbook, however it identifies the first set off the index and doesn't tag the first set then which has led to me setting up a if statement to by pass this, which adds duplicate to the first instance too. This is taking a long time to do however and would like to improve this, if possible. Any suggestions would be greatly appreciated, I am new to VBA but have been learning bits as I've encountered new problems!
'Declaring the lastRow variable as Long to store the last row value in the Column1
Dim lastRow As Long
'matchFoundIndex is to store the match index values of the given value
Dim matchFoundIndex As Long
'iCntr is to loop through all the records in the column 1 using For loop
Dim iCntr As Long
Dim first_dup As Long
Dim tagging As Long
Dim item_code As String
'Finding the last row in the Column 1
lastRow = Range("B1000000").End(xlUp).Row
'
'looping through the column1
For iCntr = 2 To lastRow
'checking if the cell is having any item, skipping if it is blank.
If Cells(iCntr, 1) <> "" Then
'getting match index number for the value of the cell
matchFoundIndex = WorksheetFunction.Match(Cells(iCntr, 1), Range("A1:A" & lastRow), 0)
'if the match index is not equals to current row number, then it is a duplicate value
If iCntr <> matchFoundIndex Then
'Printing the label in the column B
Cells(iCntr, 4) = "Duplicate"
End If
End If
Next
For first_dup = 2 To lastRow
If Cells(first_dup, 5) = "Duplicate" Then
item_code = Cells(first_dup, 1)
For tagging = 2 To lastRow
If Cells(tagging, 1) = item_code Then
Cells(tagging, 5) = "Duplicate"
End If
Next
End If
Next
Example data:
item code
1
2
3
4
1 duplicate
2 duplicate
3 duplicate
4 duplicate
1 duplicate
2 duplicate
3 duplicate
4 duplicate
My first suggestion is not to over-complicate things, try using duplicate values conditional formatting to see if this helps:
Failing that, if you are desperate to find ONLY the duplicates, and not the first occurrence, you can use a formula like this: (In Cell B2 if your Data starts in A2, it will require a header row that doesn't match, or your first row will always match)
=IF(COUNTIF($A1:A$1,A2)>=1,"Duplicate","")
Which when pasted down your row of data could look something like this:
There are also VBA solutions if you are desperate for a VBA solution, but I thought I'd give you the simple ones first. Let me know how you get on in the comments.
Edit: you can just insert the above formula using VBA, with R1C1 notation, e.g.:
Sub test()
Range("B2:B" & Range("A1").End(xlDown).Row).FormulaR1C1 = "=IF(COUNTIF(R1C1:R[-1]C1,RC1)>=1,""Duplicate"","""")"
End Sub
I'll break this down so you know what is happening.
Range("B2:B" & Range("A1").End(xlDown).Row) selects the cells in column B between B2 and the last filled row in column A i.e. Range("A1").End(xlDown).Row (so this won't work if you expect blanks in column A as part of your data)
Then, it sets the R1C1 ref formula to "=IF(COUNTIF(R1C1:R[-1]C1,RC1)>=1,""Duplicate"","""")", where R1C1 means first row, first column, (i.e. $A$1)
R[-1]C1 means previous row, first column. For example,
If you are in B5, this would select A4.
If you are in A2, this would select A1.
If you are in A1, this would error out because you cant be in a row earlier than 1.
And RC1 means current row, first column.
Hope this helps!
The answer was the same as the initial code I presented, it's taking roughly 5 minutes for 30000 items so it isn't too bad at what it does.

VBA Excel word search and copying formulas

I'm searching for a VBA macro for Excel, which can detect the word "mean", in column A. After this it would copy the yellow row with the formula in C to J.
The formula counts the average from one row after the last "mean" to the next =AVERAGE (C1323:C1437)
after every sixth mean there also needs to be Area and 150 copyied two rows after mean and I and J Need to be changed. Consequently I and J would refer to the cell A1441 in this case (=G1439/C1439*$A$1441) till the end of the file.
I'm not quite sure if it's easy or not but I'm totally overchallenged. I would be very thankful for help.
Sub Makro1()
'
' Makro1 Makro
'
' Tastenkombination: Strg+q
strSearchWord = "Mean"
i = Application.WorksheetFunction.CountIf(Range("A:A"), strSearchWord)
Y = 2
For x = i To 0
i = Application.WorksheetFunction.Match(strSuchWort, Range("A:A"), 0)
Range("C" & i).Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=AVERAGE(R[-147]C:R[-1]C)" ' that's still wrong, should be something like i-y?
Selection.AutoFill Destination:=Range("C" & i:"J" & i), Type:=xlFillDefault
Range("CY:JY").Select
i = Y
'for each fifth i
'Range("A" & i + 3).Select
' ActiveCell.FormulaR1C1 = "=RC[-2]/RC[-6]*R2159C1"
Next x
End Sub
it's still wrong, but my first draft.
#stucharo the Area correction is difficult to describe I've added a better Picture with formulas. I hpe that now it's understandable
If your line ActiveCell.FormulaR1C1 = "=AVERAGE(R[-147]C:R[-1]C)" needs to change the number of rows betwen means each time then you'll need to add a variable as you comment suggests. Also, just writing the string to the cells value (ActiveCell.Value) means that you will see it written as a formaula when you click the cell in the workbook (and it'll highlight the range etc.). You could try replacing it with:
ActiveCell.Value = "=AVERAGE(R[" & i - Y & "]C:R[-1]C)"
although since I can't see the first row of your sheet I'm not certain that'll give you the correct range of rows each time.
If your row number is likely to change and you are copying over the same number of columns each time then it might also be just as easy to write the formula directly to cells within a loop, rather than explicitly copying it.
Adding text after every 6th "mean" would require you to keep count of how many means had passed so far. This can be done by incrememnting a counter variable and using the Mod operator will tell you the remainder after a division. Therefor numberOfMeans Mod 6 will give you the remainder when divided by 6 and when this equals zero you know you have a multiple of 6. I've tried to capture all this into the code below.....
Sub Test()
Application.ScreenUpdating = False
Dim startRow As Integer
startRow = 2
Dim endrow As Integer
endrow = Range("A2").End(xlDown).row
Dim lastMeanRow As Integer
lastMeanRow = startRow - 1
Dim areaRow as Integer
areaRow = lastMeanRow + 3
Dim meanCounter As Integer
meanCounter = 0
Dim avgColHeight As Integer
Dim col As Integer
Dim row As Integer
'Check each row in the sheet
For row = startRow To endrow
'Cols i and j in every row need to be modified
For col = 9 To 10
Cells(row, col).Value = "=RC[-2]/RC[-6]*R" & areaRow & "C1"
Next col
'If column 1 of that row contains "mean" then
If Cells(row, 1).Value = "mean" Then
'Calculate the column height to average over....
avgColHeight = row - lastMeanRow - 1
'...and loop through each of the columns....
'(including i and j to add average)
For col = 3 To 10
'....inserting the averaging formula.
Cells(row, col).Value = "=AVERAGE(R[-" & avgColHeight & "]C:R[-1]C)"
Next col
'Then increment the counter to keep track of the number of means
meanCounter = meanCounter + 1
'If the number of means is a multiple of 6 then
If (meanCounter Mod 6 = 0) Then
'insert the "Area" and "150" strings
Cells(row + 2, 1).Value = "Area"
Cells(row + 3, 1).Value = "150"
areaRow = row + 3
End If
'Finally change the lastMeanRow to the mean row we have just processed.
lastMeanRow = row
End If
'Do it again until we reach the end of the data
Next row
Application.ScreenUpdating = True
End Sub
I also noticed your point on the value of area changing periodically. Writing this programatically, as above, will aloow you to add some logic over the value of "Area" and when it changes.
You clearly have a long list of data and want to automate the creation of the rows and formulas you describe.
It is possible write VBA to scan through the data and modify the formulas etc but first I would question if this is the best approach to give you what you need.
Excel has a feature called "pivot tables" which essentially allows you to summerise data in a list.
for instance if the list had one row for each city in the world and gave the population in the city, and a column gave which country it was in. A pivot table could be used to create the average population for a country of the countries cities. I suspect you are doing this sort of thing.
If you don't know about pivot tables you should find out about them. See here
In your case your mean row is summeriseing data in the rows above it. To use pivot tables you would have to have a column that defined which group each row is in. You pivot table would sue this column as a row summary and you would then create the average for all the other column.
#Nathalie. It's hard to help without knowing more. eg Is the data delivered with the mean text already inserted. It looks like column A has a number the represent the row number within the group (and this could be used by a formula to create the "Group Name" column you need for pivot tables.
You can get the pivot tables to do the area adjustment by:
Creating a new set of columns which contains formulas that cause the values in columns C to J to be copied except for when it is the 6th set of data in which case you adjust the values in C to J accordingly).
You probably need to introduce columns that:
A. give the "group name"
B. give a count of which group it is in so every 6th you can do the adjustment you need.
4 by using pivot tables and basic techniques you will find it easie rot update the refresh the data, should you need to.

Populating multiple sheets with information from a table

I am working on filling out 100 instances of a form from data that I have in a master table. I am looking for a way to automate this.
The form has the fields NAME and DATE (as well as others) I am looking to create a code that will take the NAME and DATE from a row in the master table, fill it into the form that is on a separate sheet, and then repeat the process for the next row and sheet. Example:
Sheet 1: Will take NAME and DATE from Row A
Sheet 2: Will take NAME and DATE from Row B
Sheet 3: Will take NAME and DATE from Row C
...
I'm attempting to learn VB on the fly with this, but have been unsuccessful thus far.
For my quick attempt to work, your sheets will need to have similar names with an incremented number at the end (sheet1, sheet2, ...) and your master data table sheet to be named "MasterData". Also it assumes your names are in column A and dates, column B, and that you start at the first row.
Sub NameDate()
Dim i As Integer
For i = 1 To 100 'assuming 100 sheets
Sheets("Sheet" & i).Range("A1") = Sheets("MasterData").Range("A" & i) 'placing the name in row i in the Sheet's A1 cell
Sheets("Sheet" & i).Range("B1") = Sheets("MasterData").Range("B" & i) 'placing the date in row i in the Sheet's B1 cell
Next 'next i = next row for the master data sheet AND the next sheet as well
End Sub
This is extremely basic, highly improveable, and I can explain how it works in the comments if you don't understand.
Try something like this:
I would highly recommend you test this code on a seperate worksheet first with only a few "names" and "dates"
Let me know if this is what you needed or if you need it to be modified!
Create a new button with the following code:
Dim ColumnA As String
Dim ColumnB As String
Range("A2").Select
Do Until IsEmpty(ActiveCell)
ColumnA = ActiveCell.Value
ColumnB = ActiveCell.Offset(columnOffset:=1).Value
ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)
Range("A1").Value = ColumnA
Range("B1").Value = ColumnB
ThisWorkbook.Sheets("Sheet1").Activate
ActiveCell.Offset(rowOffset:=1).Select
Loop
End Sub

Excel: Copy-paste rows in between sheets depending on multiple criteria

Thank you for the comments so far, it has helped me formulate my question better/differently.
I have two sheets, Sheet1 and Sheet2.
Sheet1 contains ~100,000 rows with 5 columns and Sheet2 should contain a subgroup of Sheet1, depending if the rows in Sheet1 contain certain values in certain columns.
This is the code I have so far. Somehow the VBA doesn't give me any error, but the code also doesn't run, which makes it difficult to find a possible solution. Anyone any ideas?
Sub CopyRows()
Dim r As Integer
Dim cell As Range
r = 2
For Each cell In Selection
If Application.WorksheetFunction.IsNA(Sheets("Sheet1").Cells(r, 1)) = False Then
If Sheets("Sheet1").Cells(r, 3) = "Product1" or "Product2" Then
If Sheets("Sheet1").Cells(r, 5) = "2011" or "2012" Then
If Sheets("Sheet1").Cells(r, 4) > 0 Then
cell.EntireRow.Copy Destination:=activesheet.Rows(r)
r = r + 1
End If
End If
End If
End If
Next cell
End Sub
For such consolidations my first bet would be a Pivot table; in your case
Company & City at the vertical
product at the horizontal (if not too many)
count or sum of value inside
plus eventually a filter to exclude empty key fields.
If you arrange your sheet1 so that there is only one header line in row 1, you can select entire columns (say $A:$D) as pivot table input range, and any additional rows will be included in the Pivot upon refresh.
Of course, the Pivot table can be sorted, filtered, subtotaled etc. etc.