I am having a difficult time coming up with a solution for a project I'm working on. I am needing a Macro to look at a specific sheet, find a specific value, and cut/paste that value at the end of the row.
Looking at the example file I have attached, you can see that each customer has a unique ID in column A.
They are answering a questionnaire, and each answer they give generates a unique ID.
The order of the answer ID's doesn't matter, as they are unique. The only one that DOES matter is the answer with Semicolons. That answer ID needs to be the customer's last ID. So I need to find a way to cut these answer ID's and paste them to the end of each row.
I want the semi-colon answer to be the last answer in the array. First time posting on here so I'm sorry if the format is incorrect.
Updated: Example File
I think that this will do what you're looking for. It goes through columns and loops through each row in those columns and once it finds a cell with a ;, it just moves that value down to the bottom of the row it was found in.
Sub AnswerID()
Dim lastCol As Long
lastCol = Cells(1, Columns.count).End(xlToLeft).Column
Dim i As Long
For i = 1 To lastCol
Dim lastRow As Long
lastRow = Cells(Rows.count, i).End(xlUp).row
Dim j As Long
For j = 1 To lastRow
If InStr(Cells(j, i), ";") > 0 Then
Cells(lastRow, i).offset(1, 0).Value2 = Cells(j, i).Value2
Cells(j, i).Value2 = vbNullString
Exit For
End If
Next j
Next i
End Sub
Related
For example, I have a data as the following in a column:
I need to make all possible unique combinations of this in another table in 2 columns using VBA like below:
Any help on how can I achieve this? Thanks.
PS. The column data is variable. It can have various number of currencies. The above one is just a small example.
This is an example how to find all these permutations. With this you should be able to solve it.
Option Explicit
Public Sub FindPermutations()
Dim ws As Worksheet
Set ws = Worksheets("Sheet1")
Const fRow As Long = 2 'first row
Const lRow As Long = 5 'last row
Dim i As Long, j As Long
For i = fRow To lRow
For j = i + 1 To lRow
'print out all permutations
Debug.Print ws.Cells(i, "A").Value, ws.Cells(j, "A").Value
Next j
Next i
End Sub
How does it work?
It uses 2 loops. The first one i runs through all rows. The second j only from the current i row to the last row. This ensures that already found combinations are not used again.
Note that I used constants for fRow and lRow for an easy demonstration. You might want to change them into variables in a production environment.
Looking to automate the insertion of a VLOOKUP formula in a cell.
When recording the macro I instruct it to populate the columns below with the same formula. Works great, however, there is an issue when the table that the VLOOKUP searches through changes (more or less rows).
As it's recorded, the VLOOKUP drops down to the final row in the table (273). However, I want to set it up so that it will go down to the very last row. Meaning that I can run the script on tables of varying numbers of rows.
Selected columns will remain the same.
Range("AJ2").Select
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(RC[-20], Previous!R2C2:R273C22,17,FALSE)"
try this:
With Worksheets("Previous")
Range("AJ2").FormulaR1C1 = _
"=VLOOKUP(RC[-20], Previous!R2C2:R" & .Cells(.Rows.Count, 2).End(xlUp).Row & "C22,17,FALSE)"
End With
where:
Range("AJ2")
will implicitly reference the ActiveSheet
.Cells(.Rows.Count, 2).End(xlUp).Row
will reference "Previous" worksheet, being inside a With Worksheets("Previous")- End With block
#nbayly said it, plenty of posts on this. Infact i have provided an answer to this before here:
How to Replace RC Formula Value with Variable
below is slightly modified for a dynamic range, which is what i believe you are looking for
For j = n To 10 Step -1
If Cells(j, 1).Value = "" Then
Cells(j, 1).Formula = "=VLookup(RC20,Previous!R2C2:R273C22,17,FALSE)"
End If
Next j
remember to define j as long and n=sheets("sheetname)".cells(rows.count,1).end(xlup).row
replace 10 in j = n to 10 with the starting row number
I initially asked a question below.
Basically I want VBA to look at Column L:L. If the cell=program, and the cell below does not equal lathe I want the row above to be deleted. If the cell doesn't equal program continue looking until the end of the data.
Realized I needed to look at the data different, as I was losing rows that I needed to stay.
New logic, which I think will still use some of the old program, but
it needed to be sorted using another column. I need the VBA to look at
column E:E. If the cell in the row below is a duplicate of the cell
above, then look at column L in that row to see if the cell says
Program. If so the cell below should be Lathe. If not lathe delete the
Program Row, If it is Lathe leave both rows. If the Cells in Column E
are not duplicates, continue looking. EX. If E5=E6, If not continue
looking. If yes Look at L5 to see if it say Program. If so look at L6
for Lathe. If not delete ROW5.
This I what I received that answered teh first question which I think will still get used
Dim rngCheck as Range
Dim rngCell as Range
Set rngCheck = Range("L1", "L" & Rows.Count - 1)
For each rngCell in rngCheck
If rngCell.value = "Program" And rngCell.offset(1,0).value <> "lathe" then
rngCell.offset(-1,0).EntireRow.Delete
End if
Next rngCell
This should do it
For i = ThisWorksheet.Cells.SpecialCells(xlCellTypeLastCell).Row to 2 step -1
' that row do you mean the duplicate or the original (I am using original)
If ThisWorksheet.Cells(i, 5) = ThisWorksheet.Cells(i-1, 5) and _
ThisWorksheet.Cells(i-1, 12) = "Program" and ThisWorksheet.Cells(i, 12) <> "Lathe"
ThisWorksheet.Rows(i-1).EntireRow.Delete
End If
Next i
When deleting it is best to iterate from last to first. If prevent you from skipping rows.
Sub RemoveRows()
Dim x As Long
With Worksheets("Sheet1")
For x = .Range("E" & .Rows.Count).End(xlUp).Row To 2 Step -1
If .Cells(x, "E").Value = .Cells(x - 1, "E").Value And Cells(x - 1, "L").Value = "Program" Then
.Rows(x).Delete
End If
Next
End With
End Sub
Closed. This question is not reproducible or was caused by typos. It is not currently accepting answers.
This question was caused by a typo or a problem that can no longer be reproduced. While similar questions may be on-topic here, this one was resolved in a way less likely to help future readers.
Closed 6 years ago.
Improve this question
I am new to VBA and coding in general.
I was trying my best to create a little VBA to help me automatically sum the rows of a table.
In my code, I have bolded the output. ie. after i click the macro, the sum is supposed to show and it is also supposed to be bolded.
However,I am not sure where I went wrong. :o Whenever I run, there is nothing seen.
I have tried to solve it by myself but it finds fault with the
.Cells(j, 1stCol + 1)
for both lines. I am not sure if there are any other faults because I cannot troubleshoot this myself.
Could anybody kindly help?
Also, does anybody have any good books to read up more on VBA? The internet confuses me quite a lot of the time I am trying to learn.
Thank you all for your help!
here is my code.
Option Explicit
Sub addHorizontalSums()
Dim lstCol As Integer
With Excel.ThisWorkbook.Sheets("Sheet1")
lstCol = .Cells(1, .Columns.Count).End(Excel.xlToLeft).Column
Dim j As Integer
For j = 1 To .Cells(1, .Columns.Count).End(Excel.xlToLeft).Column
.Cells(j, 1stCol + 1) = "=SUM(RC[-" & lstCol - 1 & "]:RC[-1])"
.Cells(j, 1stCol + 1).Font.Bold = True
Next j
End With
End Sub
This is an update...
Davesexcel,
The formula you gave I think only works if all the rows are the same length, however, if they arent, it will cut the data in half based on the first row found. I need to be able to calculate rows of different lengths.
The updated code you gave doesnt work too well. If you look at the Note Column, there are like many gaps of different gap spaces and the latest formula always results in debug message, without being fully calculated.
Is there a way for me to SUM all the numbers in each little sub-table BUT only subtracting the last no. Eg. if there are 9 items in a list with the 10th being the subtotal, is there code to SUM the 9 and then subtract the 10th, to give an overall result of 0?
Lastly, is it possible to highlight all the data that is being churned out, say in yellow? This would help me do the recording down quickly.
Thanks guys for all of your help!
Appreciated with much thanks! :)
First, you probably meant to write lstCol instead of 1stCol in the For-loop.
Second, if I get you right you want to show the sum of each row after the last cell in each row. If so, the variable j must go from 1 to the number of rows used on your sheet, not the number of columns. The following code should do the task.
Sub addHorizontalSums()
Dim j As Integer
Dim lstCol As Integer
With Excel.ThisWorkbook.Sheets("Sheet1")
lstCol = .Cells(1, .Columns.Count).End(Excel.xlToLeft).Column
For j = 1 To .Cells(1, 1).End(xlDown).Row
.Cells(j, lstCol + 1) = "=SUM(RC[-" & lstCol - 1 & "]:RC[-1])"
.Cells(j, lstCol + 1).Font.Bold = True
Next j
End With
End Sub
As a remark, you might want to use a different way to determine lstCol in case you have different numbers of entries in each row. You could for example use the following code, which I think should be more robust:
Sub addHorizontalSums()
Dim j As Integer
With Excel.ThisWorkbook.Sheets("Sheet1")
For j = 1 To .Cells(1, 1).End(xlDown).Row
.Rows(j).End(xlToRight).Offset(0, 1).Value = Application.WorksheetFunction.Sum(Rows(j))
.Rows(j).End(xlToRight).Font.Bold = True
Next j
End With
End Sub
You are limiting the number of rows to equal the number of columns, you should count the columns and rows separately.
For example,(change 1 to 2 in the rng,if you want it to start on row 2)
Sub Button2_Click()
Dim LstCol As Long, LstRw As Long, Rng As Range, Sh As Worksheet
Set Sh = Sheets("Sheet1")
With Sh
LstCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
LstRw = .Cells(.Rows.Count, LstCol).End(xlUp).Row
Set Rng = .Range(.Cells(1, LstCol + 1), .Cells(LstRw, LstCol + 1))
End With
With Rng
.Formula = "=SUM(RC[-" & LstCol & "]:RC[-1])"
.Font.Bold = 1
.Value = .Value 'use if you only want to show values, not formula
End With
End Sub
Sum between blanks
Before
After
Sub SumBetweenBlanks()
Dim RangeArea As Range, x As Long
x = Cells(1, Columns.Count).End(xlToLeft).Column
For x = 1 To x
For Each RangeArea In Columns(x).SpecialCells(xlCellTypeConstants, 1).Areas
With RangeArea.Offset.End(xlDown).Offset(1)
.Value = Application.Sum(RangeArea)
.Font.Bold = 1
End With
Next RangeArea
Next x
End Sub
Ok,
Hopefully this isn't too convoluted. I'm trying to filter a large number of transactions based on customer ID number. I have a list of about 60 important customers I need to track in a separate sheet. It has their customer ID number and then their name and other data. So everyday I'm taking about 20,000 transactions and filtering them manually. Then going through and copying and pasting the first instance of each transaction for the day into another sheet.
So Far this is what I have:
Dim Arr() AS Variant
Arr = Sheet2.range(“A1:A60”)
LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
ActiveSheet.Range(“A1:A” & LastRow).AutoFilter Field:=1,_
Criterial:=Arr, Operator:=xlFilterValues
Dim r As Long, endRow As Long, pasteRowIndex As Long
pasteRowIndex = 1
For r = 1 To LastRow
If Cells(r, Columns("A").Column).Value <> Cells(r + 1, Columns("A").Column).Value
Then Rows(r).Select
Selection.Copy
Sheets("Sheet3").Select
Rows(pasteRowIndex).Select
ActiveSheet.Paste
pasteRowIndex = pasteRowIndex + 1
Sheets("Sheet1").Select
End If
Next r
As of now it's untested because I'm on vacation. Does this code look proper? If not, what can I do better?
Thanks
A few notes:
Change Columns("A").Column to just 1, there is no need to have it like that since you aren't checking other columns.
For LastRow it may be easier to simply use Cells(1,1).End(xlDown).Row
From what I can see your if command is checking the cell after for the same ID number. This would imply that the last transaction from that ID number is the only one being passed. If you have headings the first row then you could use
If Cells(r, Columns("A").Column).Value <> Cells(r - 1 1, Columns("A").Column).Value
and start with r = 2
Also it seems as though when you are filtering you are only filtering the A column. Change to the following and it should work
LastCol = Cells(1,1).End(xlToRight).Column
ActiveSheet.Range(Cells(1,1),Cells(LastRow,LastCol)).AutoFilter Field:=1,_
Criterial:=Arr, Operator:=xlFilterValues
For code simplicity you can also use Dim r, endRow, pasteRowIndex As Long and do not forget to define Dim LastRow as Integer and similar for LastCol if you decide to use it.
If there are still any issues with this when you return please feel free to let me know.