I am Comparing cells in column D and if they match paste the value of the previous cell in column B into the next cell in column B if they do not match paste the value of the subseqent cell in column A into the cell in column B
e.g
IF(D2=D3,B2,A2+1)" but this is not working after running on the 1st sequence of cells in D I get #Valve!" for the rest of column B
I am sure this is the problem IF(D2=D3,B2,A2+1)" in-particular the A2+1 reference but not sure how to call it
(Sorry if this was unclear)
Thanks
Sub TargetId()
Dim lRow As Long
Dim ws As Worksheet
Set ws = Sheets("UnPivot")
Columns("B:B").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("B1").FormulaR1C1 = "Source"
Range("B2").FormulaR1C1 = [A2].Value
With ws
lRow = ws.Range("D" & .Rows.Count).End(xlUp).Row
With .Range("B3:B" & lRow)
.Formula = "=IF(D2=D3,B2,A2+1)"
.Value = .Value
End With
End With
End Sub
As follow up from comments, this one works:
With .Range("B3:B" & lRow)
.Formula = "=IF(D2=D3,B2,A3)"
.Value = .Value
End With
Related
I've been working on this for a bit, and I've just come to a roadblock. I'm trying to format some data for graphing in Excel, and it looks like this:
Example Data
I'd like to have the output look like this:
Desired Output
The actual number of faults and days vary wildly, so it has to be open-ended, so it can do a full search of the imported file. I'm trying to do it using VBA without relying on a formula.
Let me know if there's anything I could be doing different.
Here's the code:
Sub Graph()
Dim GraphDataWS, DataWS, FormWS As Worksheet
Dim criteria1, InspectedMtr As String
Dim totalrow, ErrorRangevar, DateRangeVar, Row1, Col1 As Long
Dim Daterange, ErrorRange As Range
Dim criteria2 As Variant
Dim ErrorCount, Output As Double
Worksheets("Graph Data").Activate
Set Worksheet = ActiveWorkbook.Sheets("Graph Data")
Cells.Select
Selection.ClearContents
Selection.ClearContents
Set GraphDataWS = ActiveWorkbook.Sheets("Graph Data")
Set FormWS = ActiveWorkbook.Sheets("Formulas")
Set DataWS = ActiveWorkbook.Sheets("Data")
totalrow = FormWS.Range("A21").Value
Worksheets("Data").Range("A1:A" & totalrow).SpecialCells(xlCellTypeVisible).Copy (Worksheets("Graph Data").Range("B1"))
Worksheets("Data").Range("E1:E" & totalrow).SpecialCells(xlCellTypeVisible).Copy (Worksheets("Graph Data").Range("A1"))
With GraphDataWS
ErrorRangevar = GraphDataWS.Cells(Rows.Count, "A").End(xlUp).Row
GraphDataWS.Range("A1:A" & ErrorRangevar).Copy (GraphDataWS.Range("C1:C" & ErrorRangevar))
GraphDataWS.Range("C2:C" & ErrorRangevar).RemoveDuplicates Columns:=1
DateRangeVar = GraphDataWS.Cells(Rows.Count, "B").End(xlUp).Row
GraphDataWS.Range("B1:B" & DateRangeVar).Copy (GraphDataWS.Range("D1:D" & DateRangeVar))
GraphDataWS.Range("D2:D" & DateRangeVar).RemoveDuplicates Columns:=1
'DateRangeVar = GraphDataWS.Cells(Rows.Count, "B").End(xlUp).row
Range("D2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Range("E1").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
ErrorRangevar = ErrorRangevar + 2
Worksheets("Graph Data").Activate
Output = 0
Set Daterange = GraphDataWS.Range(Cells(1, 4), Cells(1, DateRangeVar))
Set ErrorRange = GraphDataWS.Range("C1:C" & ErrorRangevar)
For a = 2 To ErrorRangevar
criteria1 = Cells(a, 3).Value
For b = 2 To ErrorRangevar
criteria2 = Cells(a, 4).Value
For i = 2 To ErrorRangevar
If ((Cells(i, 1)) = criteria1) And (Cells(i, 2) = criteria2) Then
Output = Output + 1
End If
Next i
Row1 = ErrorRange.Find(What:=criteria1).Row
Col1 = Daterange.Find(What:=criteria2).Column
Cells(Row1, Col1).Value = Output
MsgBox criteria1 & " " & Row1 & " " & criteria2 & " " & Col1 & " Output: " & Output
Output = 0
Next b
Next a
GraphDataWS.Range("E2").Value = Output
End With
End Sub
Any other suggestions or comments are welcome, I'm still learning VBA/Excel. Thank you!
First, I'm sorry as I can't understand this sentence :
to graph information from that
porting the information from a table
Anyway, other than create a pivot table from the data seen in your first image to get the expected result as seen in your second image ... I try to make the code based on the data seen in your first image to get the expected result as seen in you second image.
Sub test()
Dim rgdt As Range: Dim dateCol As Range: Dim cell As Range
Dim rgdt1 As String: Dim rgdt2 As String
Set rgdt = Sheets("Sheet1").UsedRange
Set rgdt = rgdt.Resize(rgdt.Rows.Count - 1, rgdt.Columns.Count).Offset(1, 0)
rgdt1 = "Sheet1!" & rgdt.Columns(1).Address
rgdt2 = "Sheet1!" & rgdt.Columns(2).Address
With Sheets("Sheet2").Range("A1")
.Value = "NAME"
rgdt.Copy Destination:=.Offset(1, 0)
.Range(rgdt.Columns(1).Address).RemoveDuplicates Columns:=1, Header:=xlNo
.Range(rgdt.Columns(2).Address).RemoveDuplicates Columns:=1, Header:=xlNo
Set dateCol = .Range(rgdt.Columns(2).Address).SpecialCells(xlConstants)
dateCol.Copy
.Offset(0, 1).PasteSpecial Paste:=xlPasteAll, Transpose:=True
dateCol.Clear
For Each cell In .Range(rgdt.Columns(1).Address).SpecialCells(xlConstants)
With cell.Offset(0, 1).Resize(1, dateCol.Rows.Count)
.Value = "=countifs(" & rgdt1 & "," & cell.Address & "," & rgdt2 & ",B$1)"
.Value = .Value
.Replace What:=0, Replacement:="", MatchCase:=True
End With
Next
End With
End Sub
The sub assumed that there is nothing else in "Sheet1" but the data seen in your example data image.
First it create rgdt variable as the range of the data in "Sheet1" (sheet "Data" in your case, so change accordingly) without including the header.
Then it create rgdt1 and rgdt2 string variable to point which sheet and which column of rgdt.
Then it prepares the "skeleton" of expected result in "Sheet2" (Sheet "Graph Data" in your case):
fill cell A1 with "NAME"
copy the rgdt to cell A1.offset(1,0)
remove duplicate value in column A
remove duplicate value in column B
set the range of column B with data as dateCol variable (without the header)
copy the dateCol and paste transpose to cell A1.offset(0,1)
clear the value in dateCol
Next, it populate the value for the expected count result by looping to each cell which has value in column A, where on each loop it fill the range of cells after the looped cell to the right with COUNTIFS formula, remove the formula as value, then replace zero (0) result with nothing.
If you want to test the sub, create a new workbook, copy your data into cell A1 of "Sheet1", copy also the sub, then run the sub. See the expected result in "Sheet2".
Good afternoon friends, I need your support because when I execute my macro in VBA, the results show the formula.
What I want is to be able to carry out an IF STATEMENT where only the conditions that I have put in the formula give me as a result, that is, only the text "Approved" or "Denied".
Here is my code that I currently have:
Sub if_status()
Range("D2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-1]=""Approved"",""Approved"",""Denied"")"
Selection.AutoFill Destination:=Range("D2:D" & Range("B" & Rows.Count).End(xlUp).Row)
Range(ActiveCell, ActiveCell.End(xlDown)).Select
End Sub
I have tried this new code but it won't let me put the "ELSE" and it finally gives me an error. And neither if how to do the autocomplete until the last row:
Sub ANOTHER()
Range("D2").Select
If Range("C2").Value = "" Then Range("e2").Value = "Denied"
Else
Range("D2").Value = "Approved"
End If
End Sub
Dim ws As Worksheet
Set ws = ActiveSheet 'always specify a worksheet
With ws.Range("D2:D" & ws.Cells(Rows.Count, "B").End(xlUp).Row)
.Formula = "=IF(C2="""",""Denied"",""Approved"")" 'apply formula
.Value = .Value 'convert to value
End With
If you put something after Then on the same line, you cannot continue it on a new line.
The Then part needs its own line.
Sub ANOTHER()
Range("D2").Select
If Range("C2").Value = "" Then
Range("e2").Value = "Denied"
Else
Range("D2").Value = "Approved"
End If
End Sub
If I understand correctly, your other question can be done with this one line.
Range("C1:C" & Range("B" & Rows.Count).End(xlUp).Row).Formula2R1C1 = "=IF(RC[-1]=""Approved"",""Approved"",""Denied"")"
This assumes you have your B and C columns defined correctly.
With your code you are determining the last row using Column B, and then setting Column C based on Column B. Is that correct?
I found the way the formula is not displayed in the results and the USER can only see values. Additionally, the code validates until the last one that contains a value.
The code validates until the last row of column [B] and the IF statement validates the data of column [C] and leaves the result in column [D] only values do not show the formula..
Sub another_code()
Dim cell As Range
Set rng = Range("C2:C" & Range("B" & Rows.Count).End(xlUp).Row)
For Each cell In rng
If cell.Value <> "" Then
cell.Offset(0, 1).Value = "Approved"
Else
cell.Offset(0, 1).Value = "Denied"
End If
Next cell
End Sub
I need to constantly start at cell R2 and auto-fill a formula down to the last row of column R. However, the number of rows is constantly changing so I need to write a macro that finds the last row and stops there. My code, as it stands right now, will auto-fill column R to the end of the worksheet (not to the row where my data stops). How do I get the auto-fill to stop at the correct row where there is no longer any data?
Sub InvoicePrice()
Dim Lastrow As Long
Lastrow = Range("P" & Rows.Count).End(xlDown).Row
Range("R2").Select
ActiveCell.FormulaR1C1 = "=RC[-2]/RC[-4]"
Selection.AutoFill Destination:=Range("R2:R" & Lastrow)
End Sub
Try this (avoids select/activate):
Dim Lastrow As Long
'Lastrow = Range("P" & Rows.Count).End(xlDown).Row
Lastrow=Cells(Rows.Count, "P").End(xlUp).Row
Range("R2:R" & Lastrow).FormulaR1C1 = "=RC[-2]/RC[-4]"
set r = range("R2")
If r.Offset(1, 0) <> "" Then
lastRow = r.End(xlDown).row
Else
lasRow = r.row
End If
I am currently using this script.
Range("E2").Select
Range(Selection, Selection.End(xlDown)).Select
For Each xCell In Selection
xCell.Value = CDec(xCell.Value)
Next xCell
I want to only select the cells in column E that have data, but the amount of cells that have data varies, and I don't want to select E1 because it has a header. This code changes the foreign text in column E to numbers that I can actually use the sum function to add up. The way it is written now it puts a 0 in all of the cells in the column infinitely.
Try following code:
Dim lastrow As Long
lastrow = Application.Max(2, Cells(Rows.Count, "E").End(xlUp).Row)
With Range("E2:E" & lastrow)
.NumberFormat = "0"
.Value = .Value
End With
UPD:
if it doesn't help, try this:
Dim lastrow As Long
lastrow = Application.Max(2, Cells(Rows.Count, "E").End(xlUp).Row)
For i = 2 To lastrow
With Range("E" & i)
.Value = CDec(.Value)
End With
Next
I have an Excel sheet with names in column A and an amount in column B for sheet 1.
I have a another sheet that is sheet2 with names in A just like in sheet 1 and column B is blank.
How can I check sheet 1 A name to check with sheet2 A name, if they match then take amount next to that name on sheet1 and copy the amount into the cell next to the matching name on sheet2 next to the name? The names on sheet1 change daily.
I have tried this and get nothing.
Sub Macro1()
'
' Macro1 Macro
'
Dim RowIndex As Integer
Sheets("Sheet1").Select
RowIndex = Cells.Row
While DoOne(RowIndex)
RowIndex = RowIndex + 3
Wend
End Sub
Function DoOne(RowIndex As Integer) As Boolean
Dim Key
Dim Target
Dim Success
Success = False
If Not IsEmpty(Cells(RowIndex, 1).Value) Then
Key = Cells(RowIndex, 1).Value
Sheets("sheet2").Select
Set Target = Columns(2).Find(Key, LookIn:=xlValues)
If Not Target Is Nothing Then
Rows(Target.Row).Select
Selection.Copy
Sheets("Sheet1").Select
Rows(RowIndex + 1).Select
Selection.Insert Shift:=xlDown
Rows(RowIndex + 2).Select
Application.CutCopyMode = False
Success = True
End If
End If
DoOne = Success
End Function
Sheet 1:
A B
A One Preservation $16.00
A&D Recovery, Inc. $8,108.46
A&S Field Services, Inc. $4,941.56
A&T Jax Inc $1,842.48
Sheet 2:
A B - blank cell
A One Preservation - Calvin & Renee
A&D Recovery, Inc. - Drew & Adam
A&S Field Services, Inc. - Aaron
A&T Jax Inc - Tyson
This code uses an Index/Match solution to copy the matched B values from sheet1 from sheet2. The code will work with variable sheet names
blank cells are ignored
Non-matches on the second sheet are flagged as "no match".
The code removes the formulae from column B on the second sheet by updating with values only
Update: if you second sheet names are the same as sheet1, but have a " -some text" to the right, then use this updated part of the code
With rng1.Offset(0, 1)
.FormulaR1C1 = "=IF(RC[-1]<>"""",IF(NOT(ISERROR(MATCH(LEFT(RC[-1],FIND("" -"",RC[-1])-1),'" & ws1.Name & "'!C[-1],0))),INDEX('" & ws1.Name & "'!C,MATCH(LEFT(RC[-1],FIND("" -"",RC[-1])-1),'" & ws1.Name & "'!C[-1],0)),""no match""),"""")"
.Value = .Value
End With
original
Sub QuickUpdate()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim rng1 As Range
Set ws1 = Sheets(1)
Set ws2 = Sheets(2)
Set rng1 = ws2.Range(ws2.[a1], ws2.Cells(Rows.Count, "A").End(xlUp))
With rng1.Offset(0, 1)
.FormulaR1C1 = "=IF(RC[-1]<>"""",IF(NOT(ISNA(MATCH(RC[-1],'" & ws1.Name & "'!C[-1],0))),INDEX('" & ws1.Name & "'!C,MATCH(RC[-1],'" & ws1.Name & "'!C[-1],0)),""no match""),"""")"
.Value = .Value
End With
End Sub
Why not use the VLOOKUP function?
Sheet1 has your names in column A, and values in column B.
Sheet2 has your lookup names in column A, and in column B, you put:
=VLOOKUP(A1,Sheet1!$A$1:$B$n,2,FALSE)
Where 'n' is the number of rows in your Sheet1 table.
The only issue with this is it will put an #N/A if it can't find the name in Sheet1. There's likely a way to put in an alternate entry using a conditional.