I have several tables pasted one after another, I am trying to add two extra columns, one for the skill name and one for the date. When i run this code, the columns are added and I can see the pointer going to each cell, but it is not assigning any values. I will appreciate your suggestions on this code.
Dim date_var As String
Dim skill_var As String
Dim msg_var As Integer
Sub Add_Date_Skill()
ThisWorkbook.ActiveSheet.Range("A1").Select
ActiveCell.EntireColumn.Insert
ActiveCell.EntireColumn.Insert
ThisWorkbook.ActiveSheet.Range("C2").Select
Do While Not IsEmpty(ActiveCell.Value)
If ActiveCell.Value = "Date" Then
ActiveCell.Offset(0, 1).Select
Let date_var = ActiveCell.Value
ActiveCell.Offset(0, -1).Select
ElseIf ActiveCell.Value = "Split/Skill" Then
ActiveCell.Offset(0, 1).Select
Let skill_var = ActiveCell.Value
ActiveCell.Offset(0, -1).Select
Else
ActiveCell.Offset(0, -2).Select
ActiveCell.Value = skill_var
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = date_var
ActiveCell.Offset(0, 1).Select
End If
ActiveCell.Offset(1, 0).Select
Loop
End Sub
Solved, the Date and Split/Skills have a Colon (:) at the end!
Related
I would like to copy certain cells from a report to another worksheet.
There are two conditions and two rows to copy if one of the conditions applies.
As I am new to VBA, I don`t get the loop to work.
Main problem: How to increment the row that is to be searched and that is the paste target (B1->B2->B3..).
The loop is supposed to check and copy until the last row of the report.
So the
Can somebody help me how to code the loop or explain in an easy way how to do that? Thank you! :)
Sub CopyRow()
'Return to Sheets("CS15 Download"), Find Last Row and LastRow = that row
Sheets("CS15").Select
Range("A8").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.End(xlUp).Select
LastRow = ActiveCell.Row
Dim ObjDes As Variant
Const Lvl As Integer = 1
ObjDes = Range("Q1").Value
Range("B3").Select
If Range("B3").Value = Lvl Then
Sheets("Report").Range("B2").Value = Range("F3").Value
Sheets("Report").Range("C2").Value = Range("G3").Value
ActiveCell.Offset(1, 0).Range("A1").Select
ElseIf InStr(Range("G3").Value, ObjDes) > 0 Then
Sheets("Report").Range("B2").Value = Range("F3").Value
Sheets("Report").Range("C2").Value = Range("G3").Value
ActiveCell.Offset(1, 0).Range("A1").Select
Else
ActiveCell.Offset(1, 0).Range("A1").Select
End If
End Sub
I can't overcome this seemingly simple issue involving the use of a variable in a countif function - hoping you guys can help. I'm looping through a list of data that spans 2006 through 2024, using the if statements to determine the beginning and the end of my search range, which will be used in the countif function at the end of the code. The do/loop section appropriately defines the ranges, however I receive errors when the macro attempts to place the countif function in the designated cell using the variable containing the search range. Here's my code:
Dim Year As Integer
Dim Month As Integer
Year = InputBox("Enter the Current Year", "Choose Year for Analysis", "Type your desired year here")
If Len(Year) = 0 Then
MsgBox "No year chosen, this macro will now end)"
Exit Sub
End If
Month = InputBox("Enter the first # that corresponds with the first month you would like to review", "Starting Month", "Enter the # that corresponds with your desired month here")
If Len(Year) = 0 Then
MsgBox "No month chosen, this macro will now end)"
Exit Sub
End If
Dim SearchStart As Range
Dim SearchEnd As Range
Dim searchrange As Range
'standard
Range("L2").Select
Do Until ActiveCell.Value = Year And ActiveCell.Offset(0, 1).Value > Month + 1
If ActiveCell.Value = Year And ActiveCell.Offset(-1, 0).Value = Year And ActiveCell.Offset(0, 1).Value = Month And ActiveCell.Offset(-1, 1).Value = Month Then
ActiveCell.Offset(1, 0).Select
Else
If ActiveCell.Value = Year And ActiveCell.Offset(-1, 0).Value = Year And ActiveCell.Offset(0, 1).Value = Month + 1 And ActiveCell.Offset(-1, 1).Value = Month + 1 Then
ActiveCell.Offset(1, 0).Select
Else
If ActiveCell.Value = Year And ActiveCell.Offset(-1, 0).Value = Year And ActiveCell.Offset(0, 1).Value = Month + 1 And ActiveCell.Offset(-1, 1).Value = Month Then
ActiveCell.Offset(1, 0).Select
Else
If Not ActiveCell.Value = Year And ActiveCell.Offset(0, 1).Value = Month And SearchStart Is Nothing Then
ActiveCell.Offset(1, 0).Select
Else
If ActiveCell.Value = Year And ActiveCell.Offset(0, 1).Value = Month And Not IsEmpty(SearchStart) Then
ActiveCell.Offset(0, -1).Select
Set SearchStart = Selection
ActiveCell.Offset(1, 1).Select
End If
End If
End If
End If
End If
If ActiveCell.Value < Year Then
ActiveCell.Offset(1, 0).Select
Else
If ActiveCell.Value < Year And ActiveCell.Offset(0, 1).Value < Month Then ActiveCell.Offset(1, 0).Select
If ActiveCell.Value = Year And ActiveCell.Offset(0, 1).Value < Month Then ActiveCell.Offset(1, 0).Select
End If
Loop
ActiveCell.Offset(-1, -1).Select
Set SearchEnd = ActiveCell
Range(SearchStart.Address, SearchEnd.Address).Select
Set searchrange = Selection
'formula to find: Current month QTY & next month QTY
Range("z2").Select
Selection.FormulaR1C1 = "=COUNTIF(" & searchrange.Address & ",RC[-1])"
In this block of code you are mixing how the ranges are addressed:
Selection.FormulaR1C1 = "=COUNTIF(" & searchrange.Address & ",RC[-1])"
You need to use the R1C1 syntax:
Selection.FormulaR1C1 = "=COUNTIF(" & searchrange.Address(ReferenceStyle:=xlR1C1) & ",RC[-1])"
FYI, you should avoid using Select, so you can replace:
Range("z2").Select
Selection.FormulaR1C1 = "=COUNTIF(" & searchrange.(AddressReferenceStyle:=xlR1C1) & ",RC[-1])"
With:
Range("z2").FormulaR1C1 = "=COUNTIF(" & searchrange.Address(ReferenceStyle:=xlR1C1) & ",RC[-1])"
I have read just about every other question on here on merging rows and consolidating data. I did come across a solution I think will work for me, but when I ran the macro it didn't actually sum the right column. Being new to VBA, I'm having trouble figuring out what needs to change in the macro to work in my sheet.
Background:
I want to use a macro because I get a report every day that I have to manipulate so that it can process into our system. I have created a VBA macro to do the manipulation for me, but I have realized that the report now has duplicate lines with different values. Below is an example with the last set of numbers needing to be added together. (Column J on my actual report)
i.e.
Row 1: C3=1234, Name, C5=ABC, C5Name, C4=DEF, C4Name, 21361
Row 2: C3=1234, Name, C5=ABC, C5Name, C4=DEF, C4Name, 132165
This is the solution I found, but I need to know what to change to correspond with the column I actually need summed up.
Sub Merge()
Dim ColumnsCount As Integer
Dim i As Integer
Range("A1").Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
Do While ActiveCell.Row <= ActiveSheet.UsedRange.Rows.Count
If ActiveCell.Value = ActiveCell.Offset(1, 0).Value Then
For i = 1 To ColumnsCount - 1
ActiveCell.Offset(0, i).Value = ActiveCell.Offset(0, i).Value + ActiveCell.Offset(1, i).Value
Next
ActiveCell.Offset(1, 0).EntireRow.Delete shift:=xlShiftUp
Else
ActiveCell.Offset(1, 0).Select
End If
Loop
End Sub
Any and all help is greatly appreciated. Please let me know if I need to provide additional information.
~Andrea
It would have been better to see your table. You still have not explained enough. This answer is not so different from user1016274's answer. The code above first order by the columns B, D and H then checks and deletes the duplicates by the time adding up their J column values, by comparing same columns.
Sub Merge()
Range("A1").Sort Key1:=Range("B1"), Order1:=xlAscending, Key2:=Range("D1"), Order2:=xlAscending, _
Key3:=Range("H1"), Order3:=xlAscending, Header:=xlYes
'I assume there are column headers. If not, use "Header:=xlNo" instead of "Header:=xlYes"
Range("A2").Select 'I assume there are column headers. If not, use "Range("A1").Select" instead of "Range("A2").Select"
Do While ActiveCell.Row <= ActiveSheet.UsedRange.Rows.Count
If ActiveCell.Offset(0, 1).Value = ActiveCell.Offset(1, 1).Value And ActiveCell.Offset(0, 3).Value = ActiveCell.Offset(1, 3).Value And ActiveCell.Offset(0, 7).Value = ActiveCell.Offset(1, 7).Value Then
ActiveCell.Offset(0, 9).Value = ActiveCell.Offset(0, 9).Value + ActiveCell.Offset(1, 9).Value
ActiveCell.Offset(1, 0).EntireRow.Delete shift:=xlShiftUp
Else
ActiveCell.Offset(1, 0).Select
End If
Loop
End Sub
You don't have to loop through all columns just to add column J's values:
If ActiveCell.Value = ActiveCell.Offset(1, 0).Value Then
ActiveCell.Offset(0, 10).Value = ActiveCell.Offset(0, 10).Value + ActiveCell.Offset(1, 10).Value
ActiveCell.Offset(1, 0).EntireRow.Delete shift:=xlShiftUp
Else
ActiveCell.Offset(1, 0).Select
End If
BTW, are you sure you want to increment the active cell's row only if the row is not duplicated? Might be that it works because of the DeleteRow operation but I just wanted to ask.
edit: deleted orphaned Next statement, sorry.
I have a spreadsheet that pulls certain items out of a database by an autofilter macro and puts them into different sections. I have formulas that go in and are autofilled down to every line in each section. The problem I am running into is if a section only has one line my macro will debug. Below is my code that inserts the formulas and autofills them down. The very last row is the autofill macro and the one I need help with. Can someone please provide me an override that says if there is no lines to autofill to just move on to the next step. I'm not sure how this code would go. Thanks
'To insert formulas
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=IF(RC5<'Data Entry'!R2C2,""*"","""")"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=IF(RC18=TRUE,IFERROR(VLOOKUP(RC2,Database!C[-2]:C[9],11,FALSE),""""),0)"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=IFERROR(VLOOKUP(RC2,Database!C[-3]:C[8],10,FALSE),"""")"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=IFERROR((VLOOKUP(RC9,Pull!C1:C5,4,FALSE))*RC4,"""")"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=IFERROR((VLOOKUP(RC9,Pull!C1:C5,5,FALSE))*RC4,"""")"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=IFERROR(SUM(RC4,RC6:RC7),"""")"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=IFERROR(VLOOKUP(RC2,Database!C[-7]:C[4],6,FALSE),"""")"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=IF(RC18=TRUE,IFERROR(VLOOKUP(RC9,'Pull'!C1:C5,2,FALSE),""""),"""")"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=IFERROR(RC8*RC10,"""")"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=IFERROR(RC8+RC11,"""")"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=IFERROR(RC16*R9C13,"""")"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=IF(RC18=TRUE,IFERROR(VLOOKUP(RC9,'Pull'!C1:C5,3,FALSE),""""),"""")"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=IFERROR(RC16*RC14,"""")"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=IFERROR(RC12/(1-R9C13-RC14),"""")"
Range(Cells(Selection.Row, 3), Cells(Selection.Row, 17)).AutoFill Destination:=Range(Cells(Selection.Row, 3), "Q" & Range("B" & Rows.Count).End(xlUp).Row)
I'd set a LastRow variable, calculated the way you already do, and test whether it's greater than the Selection row:
Dim LastRow as Long
LastRow = ActiveSheet.Range("B" & Rows.Count).End(xlUp).Row
...
If LastRow > Selection.Row Then
Range(Cells(Selection.Row, 3), Cells(Selection.Row, 17)).AutoFill Destination:=Range(Cells(Selection.Row, 3), "Q" & LastRow)
EndIf
By the way, if you search on "VBA avoid Select statements" you'll get some info on why that's a good idea and how to do it. In this case I'd set a CellWithFormula variable at the beginning of the code:
Dim CellWithFormula as Excel.Range
Set CellWithFormula = Activcell
CellWithFormula.FormulaR1C1 = "=IF(RC5<'Data Entry'!R2C2,""*"","""")"
Set CellWithFormula = CellWithFormula.Offset(0, 1)
... and so on.
Looking for help on a macro to take chunks of data on further rows, and place them into columns instead.
I've attached a picture to depict this. All of the chunks of data will split determined by the first column, 1 or 2 in the picture. I simply want to move chunk two up and next to 1. The only problem I've run into is that for each chunk, the number of columns is variable.
Edit: Image link incase the embedded isn't showing up: enter link description here
Would this be relatively close?
Sub macro()
Dim wav_name As String
Range("A1").Select
Do While ActiveCell.Value <> ""
ActiveCell.Offset(0, 2).Select
wav_name = ActiveCell.Value
ActiveCell.Offset(1, 0).Select
Do
If ActiveCell.Value = wav_name Then
ActiveCell.Offset(1, 0).Select
Else
Exit Do
End If
Loop
Range(ActiveCell.Offset(0, -2), ActiveCell.End(xlDown)).Select
Selection.Cut
ActiveCell.End(xlUp).Offset(0, 3).Select
ActiveSheet.Paste
Loop
Range("A1").Select
End Sub
What you have there is pretty workable with a one key exception.
Your cut selection is only grabbing the first row of data. You will need to change it to
Range(ActiveCell).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
To handle the variable number of columns, you can capture the last column in section one by adding a varabile (i.e. LastCol) and putting the following code in your Do Loop
LastCol = Activecell.End(xlToRight).Column
Then replace the 3 in your last offset statement with your variable
Note that you can refactor the code to remove many of the select statements (includeing the ones I have mentioned above) if you need to improve the preformance of your code, but what you have written will work for you.
EDIT: Here is what your end code would look like
Sub macro()
Dim wav_name As String
Dim LastCol as Long
Range("A1").Select
Do While ActiveCell.Value <> ""
ActiveCell.Offset(0, 2).Select
wav_name = ActiveCell.Value
ActiveCell.Offset(1, 0).Select
LastCol = Activecell.End(xlToRight).Column
Do
If ActiveCell.Value = wav_name Then
ActiveCell.Offset(1, 0).Select
Else
Exit Do
End If
Loop
Range(ActiveCell.Offset(0, -2), ActiveCell.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Cut
ActiveCell.End(xlUp).Offset(0, LastCol +1).Select
ActiveSheet.Paste
Loop
Range("A1").Select
End Sub
I haven't tested this, so you may have to do some debugging... but it is now logically correct.