Excel - If cell value matches column header, copy data to column - vba

I have string data in Column A, I have number values in Column B. I also have Columns O to Z which are currently blank - these columns have headers 1, 2, 3 etc. (i.e. cell references O2=1, P2=2, Q2=3 etc.)
There is a number value in cell C1.
If C1 = matches any of the column headers (O-Z) then copy the data from Column B to the corresponding column.
Example: If C1 = 4 and cell R2 is 4, the data from Column B would populate in Column R.
How do I achieve this with VBA? Thanks in advance.

Try something like this...
Sub CopyDataDynamically()
Dim lr As Long, num As Long
Dim rng As Range
lr = Cells(Rows.Count, 1).End(xlUp).Row
Set rng = Range("O2")
num = Range("C1").Value
If num > 0 And num <= 12 Then
Range("B2:B" & lr).Copy
rng.Offset(0, num - 1).PasteSpecial xlPasteValues
End If
End Sub
If you want to achieve this with the help of a formula, try this...
In O2
=IF($B2="","",IF(O$1=$C$1,$B2,""))
and then copy it across and down as far as there is data in column B.

Related

Multiply columns of Excel table using VBA

I am trying to multiply values in two columns of a table and display it in another column.
Since this process has to be repeated for multiple columns, how should I go about referencing columns using column headers? Any help would be appreciated.
The logic would be as follows:
ListColumns(x) = ListColumns(x - 1) * ListColumns(x - 3)
This is within a loop where the value of x changes.
There are multiple ways of achieving what you are after.
1st: Let's suppose x = 4, so you want to multiply column A and C and store result in D column. Simply put formula = A1 * C1 in D1 and drag it all the way down.
2nd: Using VBA, more generic:
Sub MultiplyCoulmns()
Dim resultColumn As Long 'this is x
resultColumn = 4 'just for example, change it to whatever you need
'alternatively, specify column header
Dim header As String
header = "SomeColumn"
resultColumn = Application.WorksheetFunction.Match(header, Range("A1:Z1"), 0)
Dim i As Long, lastRow As Long
lastRow = Cells(Rows.Count, resultColumn).End(xlUp).Row
For i = 1 To lastRow
Cells(i, resultColumn) = Cells(i, resultColumn - 1) * Cells(i, resultColumn - 3)
Next
End Sub

VBA copy/paste range into rows below if there is a value in column a

I am trying to create a macro that will copy a range of values say B6:BM6 and paste it in the row below IF there is a value in column A.
So: if column A6 is populated, copy range from rows above and paste them into B6. Loop until there is no value in column A.
Sub fillEmptycells()
Dim i As Integer
Dim lastRow As Integer
With ActiveSheet
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = 2 To lastRow
If IsEmpty(.Cells(i, 2)) And Not IsEmpty(.Cells(i, 1)) Then
.Range(Cells(i - 1, 2), Cells(i - 1, 100)).Copy .Cells(i, 2)
End If
Next i
End With
End Sub
Can someone help me please?
At the moment you are only copying one cell, not a whole range. You need to change the range you call the Copy method on to include all of the cells you want to copy. The code in your If statement would be changed to something like:
.Range(Cells(i-1,2),Cells(i-1,x)).Copy .Cells(i,2)
Where x would be the column number of the last column you want to copy.

How do I delete entire rows in excel if columns J, K and L are all 0/$0.00?

I'm trying to delete entire rows in Excel 2013 but only if all cells in columns K, L and M are 0/$0.00.
Example of my data:
Excel Data Sheet
I'm wanting it to keep rows 2 - 11 as they all contain something in K, L or M. The current code that I found and have been trying to use seems to only be recognising columns L and M because it is deleting row 2 which has a figure in column K. I don't want it to calculate the totals of the 3 cells in a row because if I have a figure of $500 in column K and -$500 in column L, they'll equal to $0.00 but I need that row because there is data.
I had found 2 questions very similar to what I'm asking on this site so I tried to apply the code to what I'm doing but I must have been doing something wrong because I couldn't get it to work.
Excel VBA delete entire row if both columns B and C are blank
Delete entire row if cells in specific range are all empty
This is the code that I found and have been trying to use. Could it not be working because 1 column is positive numbers and the other 2 are negative numbers? I'm really new to using VBA etc. so I'm sorry if this is something really simple.
Sub DeleteRows()
Dim rng As Range, cel As Range
Dim N As Long
For N = rng.Rows.Count To 1 Step -1
If rng.Cells(N, 1) = 0 And rng.Cells(N, 2) = 0 Then
rng.Cells(N, 1).EntireRow.Delete shift:=xlShiftUp
End If
Set rng = ActiveSheet.Range("L1:L" & ActiveSheet.Range("L" & ActiveSheet.Rows.Count).End(xlUp).Row)
If rng.Cells(N, 1) = 0 And rng.Cells(N, 2) = 0 Then
rng.Cells(N, 1).EntireRow.Delete shift:=xlShiftUp
End If
Set rng = ActiveSheet.Range("M1:M" & ActiveSheet.Range("M" & ActiveSheet.Rows.Count).End(xlUp).Row)
If rng.Cells(N, 1) = 0 And rng.Cells(N, 2) = 0 Then
rng.Cells(N, 1).EntireRow.Delete shift:=xlShiftUp
End If
Next N
End Sub
The spread sheets that I actually work with and use every day usually contain 12,000 to 15,000 rows (file size is always about 2.5MB).
I would really appreciate any help on what I could do to make this work.
Thank you
If I understand you correctly:
Sub DeleteRows()
Dim rw As Range, r
'start on the last row
With ActiveSheet.Range("A1").CurrentRegion.EntireRow
Set rw = .Rows(.Rows.Count)
End With
Do While rw.Row > 11
r = Application.CountIf(rw.Cells(1, "K").Resize(1, 3), 0)
Set rw = rw.Offset(-1, 0)
If r = 3 Then rw.Offset(1, 0).Delete
Loop
End Sub
you may want to try this code:
Option Explicit
Sub DeleteRows()
With ActiveSheet '<--| refer to active sheet (you may want to explicitly refer to a named worksheet: 'With Worksheets("mySheet")')
With .Range("A1").CurrentRegion.Offset(, .UsedRange.Columns.Count).Resize(, 1) '<--| refer to a range in a "helper" column just outside the used range occupying the same rows as your data
.FormulaR1C1 = "=if(countif(RC11:RC13,0)=3,1,"""")" '<--| use "helper" column to mark "KLM-zero's" rows with a "1", while leaving others with a "blank" mark
If WorksheetFunction.Sum(.Cells) > 0 Then .SpecialCells(XlCellType.xlCellTypeFormulas, xlNumbers).EntireRow.Delete '<--| delete any row whose "helper" column cell is marked with "1"
.Clear '<--| clear "helper" column
End With
End With
End Sub

Comparing the cell values and printing the count in Excel using a formula or function?

I need a formula or function which is going to fulfill my below mentioned need. I have a excel data of around 11000 rows and data looks somewhat like in Column A:
Now in column B i want the result to be printed like it mentioned below: which literally means it should count the values present in column A and print it in the column B, I don't need to repeat count:
Column A Column B
PC-101 1
PC-101 1
PC-102 2
PC-102 2
PC-103 3
PC-104 4
PC-106 5
PC-107 6
PC-104 4
PC-106 5
PC-106 5
I tried with the "count" series formulas but the result was null.
Even i wrote the macro as given below( which i got from stackoverflow) but even it is printing the repeating count:
Sub CountOccurence()
' Reference: Microsoft Scripting Runtime
Application.ScreenUpdating = False
Set oDict = New Dictionary
Dim wS As Worksheet
Dim r As Integer, rLast As Integer
Set wS = Sheet1
rLast = wS.Cells(1, 1).CurrentRegion.Rows.Count
For r = 3 To rLast Step 1
If Not (oDict.Exists(wS.Cells(r, 1).Value)) Then
oDict.Add wS.Cells(r, 1).Value, 1
Else
oDict.Item(wS.Cells(r, 1).Value) = oDict.Item(wS.Cells(r, 1).Value) + 1
End If
wS.Cells(r, 2).Value = oDict.Item(wS.Cells(r, 1).Value)
Next r
Set oDict = Nothing
Application.ScreenUpdating = True
End Sub
Can anyone help me regarding this? Thanks in advance.
I tried with the "count" series formulas but the result was null.
A simple Excel formula can do this.
Put 1 in Cell B1 and then put this formula in cell B2 and pull it down.
=IF(COUNTIF($A$1:$A2,A2)>1,VLOOKUP(A2,A:B,2,0),B1+1)
Assuming that your data in column a is sorted, you can simply place 1 in B2 this formula in B3 and copy it down:
=IF(A2<>A3,B2+1,B2)
:-)

Compare given cells of each row of two tables

I am looking to update the last column of one data table with the last column of another data table. This is part of a bigger vba code. The first table spreads from A2 to column K and row "lastrpivot1". The second goes from A1001 to column K and row "lastrpivot2". Beginning with the first row of table 2 (row1001) i have to find the equivalent row in table 1 based on the values in cells A to E.
So cells A to E or frow 1001 have to be compared to cells A to E of row 2, then row 3, then row 4... until a match if found or until row "lastrpivot1". When a match is found, the value in K must return to the K value of row 1001. EX: if AtoE of row 1001 match row AtoE of row 65, then copu K65 to K1001. there shound not be more than 1 match from each table. and if there is no match there is nothing to return.
Then we start this all over for row 1002 (second row of second chart), then 1003, 1004... to lastrpivot2.
I do use vba but i do not know all the functions. this is probably why i cant figure this out.
Thnka you
In Cell K1001, try this:
=IF((A1001&B1001&C1001&D1001&E1001)=(A1&B1&C1&D1&E1),K1,"")
Then drag the formula down.
This compares the entire row 1001 to the entire row 1, which is what you're asking for.
If you intend to find the matching row like a VLOOKUP (you kind of imply this, but it is not clear that this is your intention) then you will need to use VBA to do this.
Something like (untested):
Sub MatchTables()
Dim tbl1 as Range, tbl2 as Range
Dim var1() as Variant, var2() as Variant, v as Variant
Dim r as Long, matchRow as Long
Set tbl1 = Range("A1:K500") '## Modify as needed
Set tbl2 = Range("A1001:K15001") '## Modify as needed
ReDim var1(1 to tbl1.Rows.Count)
ReDim var2(1 to tbl2.Rows.Count)
'## store the range values, conctaenated, in array variables:
For r = 1 to tbl1.Rows.Count
var1(r) = tbl1(r,1) & tbl1(r,2) & tbl1(r,3) & tbl1(r,4) & tbl(r,5)
Next
For r = 1 to tbl2.Rows.Count
var2(r) = tbl2(r,1) & tbl2(r,2) & tbl2(r,3) & tbl2(r,4) & tbl2(r,5)
Next
r = 0
For each v in Var2
r = r+1
'## Check to see if there is a complete match:
If Not IsError(Application.Match(v, var1, False)) Then
matchRow = Application.Match(v, var1, False)
'## If there is a match, return the value from column K in the first table:
tbl2.Cells(r,11).Value = tbl1.Cells(matchRow,10).Value
Else:
tbl2.Cells(r,11).Value = vbNullString
End If
Next
End Sub