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

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.

Related

Loop through column values from one sheet and paste COUNTIF value from another column into another sheet

I have two sheets in an Excel file and need to perform a COUNTIF formula from one sheet and paste the respective information in another sheet. The original sheet just has the type in 1st column with an empty 2nd column. I am trying to loop through the Type from Sheet 1, in each increment loop through the Type from Sheet 2, and past the Count of column 2 from Sheet 2 into Column 2 of sheet 1.
My current VBA code is as follows:
Sub TestOE()
'For loop to go until end of filled cells in 1st column of each sheet
a = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
b = Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
'Loop
For i = 2 To a
For j = 2 To b
If Worksheets("Sheet1").Cells(i, 1).Value = Worksheets("Sheet2").Cells(j, 1).Value Then
Worksheets("Sheet1").Cells(i, 2).Value = Application.WorksheetFunction.CountIf(Range("B:B"), 1)
End If
Next j
Next i
End Sub
This code is only pasting 0's in the desired outcome on Sheet 1.
Sheet to extract information from
Sheet to paste information in
Desired Outcome in destination sheet
You can simply use sumif function to sum the values based on criteria.
here is the formula
=COUNTIF(Sheet1!$A$2:$A$20,Sheet2!A2)
if you want to sum the col B then
=SUMIF(Sheet1!$A$2:$A$20,Sheet2!A2,Sheet1!$B$2:$B$20)
In a few steps, you can accomplish what you want without VBA, and just use a pivot table. Just do as follows.
Select your data set, including the header.
Click on insert tab, then PivotTable. See example for Office 365
Since you want a different worksheet, set PivotTable to be "New Worksheet" See example.
You'll need to drag the TYPE field into the rows, and binary into the values. CountIF is the same as summing binary, so you can leave as sum. See Example
And you'll have an output nearly identical to what you're looking for:

Get row and column number of first cell in Excel table

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.

Sumif across multiple sheets, specific rows and columns

I have 20 sheets (let's say three, for simplicity) and I need to sumif each of those sheets against one main tab with all the data in it. Each sheet is for a different business entity but each sheet has the same format:
Format: Business 1000
Format: Business 2000
I will insert monthly data into the DATA tab and will need a macro to go into Sheet 1, 2, 3 etc. and run a sumif against the DATA tab matching column B (business unit code). I will also have this run for each month so Row3 will have Actual or Forecast.
The problem:
DATA tab gets deleted and reset with next month's data, therefore all sumifs must change into values.
not all rows are equal, some may have 5-6 items and then a Sum for the total, eg: travel may include hotel, parking, meals, car rental. So SumIF can only run where column B has a code. Otherwise do NOTHING.
I don't know how to code a relative reference inside sumif. I can VBA code a column and tell it to enter "Text" into each non-blank cell. Although I can't tell it to change or have relative cell data.
Then for next month (when data tab gets reset) the next column must be filled in. If it's simpler I can add another row with an X in the active month's column, so the macro can check if there is an X in that row, then do the sum if for that column.
It's simple to run a sum if, copy paste to all non blank rows, and then recopy as value only. But not when I have 20+ sheets, and need to do that every month.
Ok, so here is an example of what you want to do. In this example, I have left it up to you to set in the code which column you are looking to fill this month.
Change the value of Const ColumnNumber = 4 to change the column you are filling this month 4=D, 5=E etc (Apologies I only work in R1C1 ref style).
FirstRow always appears to be 4, but I have left that there in case you need to change it.
Worksheetfunction.sumif takes parameters in the same order as the normal sumif, so I am passing in column 1 of the data sheet for the range, cell c of the same row as the criteria, and column 2 of the data sheet as the sum range.
Using worksheetfunction.sumif will return the value to the cell, not the formula so that solves your problem of the data sheet being deleted and recreated.
I have also left the option for you to fill in the green rows with something else.
Const ColumnNumber = 4
Const FirstRow = 4
Sub LoopSomeSheets()
Dim sht As Worksheet
'go through each sheet in the workbook
For Each sht In ThisWorkbook.Sheets
'ignore the sheet named "data"
If sht.Name <> "data" Then
Dim LastRow As Long
'figure out where the sheet ends
LastRow = sht.cells.SpecialCells(xlCellTypeLastCell).Row
'variable to sum totals
Dim RunningTotal as Double
For i = FirstRow To LastRow
If sht.Cells(i, 3).value = "SUM" Then
'Put the total value in the sum cell
sht.Cells(i, ColumnNumber).value = RunningTotal
'reset the total for the next group
RunningTotal = 0
Else
Dim SumOfData as Double
'get the sumif value
SumOfData = _
WorksheetFunction.SumIf(Sheets("data").Columns(1), sht.Cells(i, 2), Sheets("data").Columns(2))
'add to the running total
RunningTotal = RunningTotal + SumOfData
'then update the cell
sht.Cells(i, ColumnNumber).value = SumOfData
End If
Next i
End If
Next sht
End Sub

Inserting text to blank row using vba macro in excel

I have a data of say more than 5000 rows and 10 columns. I would like to add a text to the rows based on columns conditions.
A B C D
fname lname state clustername
1. ram giri NCE ...
2. philips sohia MAD ...
3. harish Gabari NCE ....
Based on the column state, for NCE the cluster name is "nce.net" has to be assigned to column D (clustername) and also for MAD is "muc.net" to be assigned to row 2.
could you please help me out.
Here is my code:
dim emptyrow as string
row_number = 1
lastRow = Cells(Rows.Count, "D").End(xlUp).Row
state = sheets("sheet1").rows("C" & row_number)
for each cell in selection
if instr(state, "NCE") = true then
Range(Cells(emptyrow, "D").Value = Array("nce.net")
end if
next emptyrow
Could you please help me out.
Why not a simple formula
In D1 and copy down
=IF(C1="NCE","nce.net",IF(C1="MAD","muc.net","No match"))
Doing the same this with code
Sub Simple()
Dim rng1 As Range
Set rng1 = Range([c1], Cells(Rows.Count, "C").End(xlUp))
With rng1.Offset(0, 1)
.FormulaR1C1 = "=IF(RC[-1]=""NCE"",""nce.net"",IF(RC[-1]=""MAD"",""muc.net"",""No match""))"
.Value = .Value
End With
End Sub
You may create a reference table consisting of unique state and clustername in a seperate worksheet and then pull the clustername into your original sheet using a =VLOOKUP() function ... provided there is a 1:1 relation between state and cluster ... even 1 cluster for multiple states would work. This way you avoid hardcoding and you can react quickly if cluster names change.
Example:
in Sheet2 list all countries and their associated clusternames
in Sheet1 enter =VLOOKUP(...) into first row of clustername column as per below picture and copy down for all rows
Of course you may want to have values only, not formulas in your cluster column; then you can convert formulas into values by copying and then pasting as values that cluster column after you've entered the =VLOOKUP(...) formula.
Alternatively, if e.g. you have a lot of clusternames already defined and only want to work on rows where clustername is blank, you can
filter for blank clusternames and insert the =VLOOKUP(...) only there
use a small piece of code
Sub DoCluster()
Dim R As Range, S As Integer, C As Integer, Idx As Integer
Set R = ActiveSheet.[A2] ' top left cell of table
S = 3 ' column index of State column
C = 4 ' column index of Clustername column
Idx = 1 ' start at 1st row within range
' run a loop across all rows, stop if 1st column gets blank
Do While R(Idx, 1) <> ""
' work only on rows wher cluster not yet set
If R(Idx, C) = "" Then
' now this isn't really good ... try to avoid hardcoding BY ANY MEANS
Select Case R(Idx, 3)
Case "NCE"
R(Idx, 4) = "nce.net"
Case "MAD"
R(Idx, 4) = "muc.net"
' insert other cases here as per need
' ...
' trap undefined cases
Case Else
R(Idx, 4) = "undefined"
End Select
End If
Idx = Idx + 1
Loop
End Sub
Personally I don't like this kind of hardcoding at all, I'd rather take the clusternames from a table ... so for me there wouldn't be a need to write code unless the whole task is much more complex than described.

Getting a total copied set of rows in VBA and storing it in a variable

I have a fairly simple syntax question:
I'm trying to copy and paste n rows from one excel file to another. In addition, I'd like to store the total copied rows into a variable.
Can someone help me accomplish this?
For example:
1)
Activate CSV file
Apply Filter to Column B (Page Title) & uncheck "blanks" ("<>") filter**
Windows("Test_Origin.xlsm").Activate
ActiveSheet.Range("$A$1:$J$206").AutoFilter Field:=2, Criteria1:="<>"
2)
Copy Filtered Lines with data (Excluding Row 1)
Range("B2:F189").Select
Selection.Copy
copiedRowTotal = total *FILTERED* rows copied over from original sheet, then Test Number iterates that many times
copiedRowTotal = Selection.Rows.Count
MsgBox copiedRowTotal
Thanks
An indirect way to do this is
Range("B2:F189").Copy
Range("M2").PasteSpecial xlPasteValues
copiedRowTotal = Selection.Rows.Count
Selection.Clear
The code copies the range & does a paste special operation on a separate location.
By doing this, only filtered rows are copied to M2 & the area (where the filtered rows are pasted) is highlighted when PasteSpecial operation is done.
Doing a Selection.Rows.Count gives one, the number of filtered rows that were pasted.
After figuring out the number of filtered rows, the selection is cleared up.
I don't believe there is a way to get the visible cell count directly. I tried using the 'SpecialCells(xlSpecialCellsVisible)' function, but could not get the correct count with a filter applied. Here is a quick function I wrote that works with a filter applied.
Also be aware that sometimes a filter can mess with the selected range at times, so it's something to note.
Public Sub TestIt()
Dim visibleCount As Long
visibleCount = GetVisibleCount(Sheets(1).Range("A2:H3000"))
MsgBox visibleCount
End Sub
Public Function GetVisibleCount(rng As Range) As Long
Dim loopRow As Range
GetVisibleCount = 0
For Each loopRow In rng.Rows
If loopRow.Hidden = False Then
GetVisibleCount = GetVisibleCount + 1
End If
Next loopRow
End Function
copiedrowtotal = selection.rows.count ' its not selection.totalcells
I think this would do the trick
After seeing your update let me tell you probably these would work
dim i as long
i = Application.WorksheetFunction.Subtotal(2,worksheets("Sheet").Range("B2:F189"))
Now i has the number of filtered rows in it! If you have included header in your range then do -1 at the end else just leave it up
argument 2 in subtotal is => counting the rows and then sheet name
and then specify range to count filtered rows
instead I would select only one column if you applied filter for many columns!
Hope it helps dont forget to accept an answer ! :