I have an excel sheet with 2 columns as below:
IMPORT_ID EXPORT_ID
SI1313721 SI1440839
SI1313721 SI1440997
SI1313722 SI1440672
SI1313722 SI1440776
SI1313722 SI1441313
IMPORT_IDs are getting repeated (SI1313721 - 2 times and SI1313722 - 3 times). I want to transpose this sheet into
SI1313721 SI1440839 SI1440997
SI1313722 SI1440672 SI1440776 SI1441313
How do I do that in Excel probably with vba?
I'm not sure if the order that they are stacked on the right matters but you could try this.
Sub TransposingColumns_to_Avoid_redundancies()
Dim rw As Long, p As Long
With ActiveSheet '<- set this worksheet reference properly!
For rw = .Cells(Rows.Count, 1).End(xlUp).Row To 3 Step -1
If CBool(Application.CountIf(.Cells(1, 1).Resize(rw - 1), .Cells(rw, 1).Value2)) Then
p = Application.Match(.Cells(rw, 1).Value2, .Cells(1, 1).Resize(rw - 1), 0)
.Cells(p, Columns.Count).End(xlToLeft).Offset(0, 1) = .Cells(rw, 2).Value2
.Rows(rw).EntireRow.Delete
End If
Next rw
End With
End Sub
The rows are deleted as the values from column B are stacked to the right. It is usually better to start at the bottom and work up when deleting rows.
Related
'The code should add the moving average to last row using array. The Prices to be use to average are in range "E6:E7555". The values will be written in "G7555". There is an existing moving average values in range "G6:G7554". Need help from Excel VBA expert to correct the codes which I think in step 1 and 2 below.
Options Explicit
Sub Add_MovingAverage_to_LastRows()
Dim maArray As Variant
Dim runSum, ma() As Double
Dim i, lRow, iPeriod, iCol As Long
iPeriod = 7
'set last row and reference range to calculate
With Worksheets("Sheet1")
lRow = .Cells(Rows.Count, 1).End(xlUp).Row 'Row "7555"
maArray = .Range(.Cells(lRow - (iPeriod -1), 5), .Cells(lRow, 5)).Value2 'Column "E"
End With
'set the lower and upper bound
ReDim ma1(lRow - (iPeriod - 1) To lRow, 1 To 1)
'step 1 calculate the SUM for last row, sum (row "7549" to row "7555")
runSum = 0
For i = lRow - (iPeriod-1) To lRow
runSum1 = runSum1 + maArray(i, 1)
Next
'step 2 calculate the AVERAGE for last row, average (row "7549" to row "7555")
ma(1, 1) = runSum / iPeriod
'write the values to worksheet
iCol = 7 'Column "G"
With Worksheets("Sheet1")
.Range(.Cells(lRow, iCol), .Cells(lRow, iCol)).Value2 = ma
End With
Erase maArray: Erase ma
End Sub
I think you may want to stick to a Formula on G column instead of VBA. If you add this formula on G6 and drag down: (Test it out on column H next to it)
=AVERAGE(INDIRECT("E"&IF(ROW()-6<6,6,ROW()-6)&":"&"E"&ROW()))
The IF Statement is to not break the formula on the first few rows of the file.
It will always grab the last 6+current row of values in Column E to calculate the Average.
Edit: Summary
="E"&IF(ROW()-6<6,6,ROW()-6)&":"&"E"&ROW() if you paste this into I6 and drag down you can see how it is just graving the 7 Cell Range you are looking for. When you enclose this into INDIRECT then you can use this inside other formulas as a "literal range" as in my answer above with AVERAGE.
Edit 2: VBA Code to automatically drag/fill down formula.
Sub UpdateFill()
Dim lRow As Long, lFormulaRow
With ThisWorkbook.Sheets("Sheet1")
lDateRow = .Cells(Rows.Count, 1).End(xlUp).Row
lFormulaRow = .Cells(Rows.Count, 7).End(xlUp).Row
If lDateRow > lFormulaRow Then
.Range("G" & lFormulaRow & ":G" & lDateRow).FillDown
End If
End With
End Sub
The last two days I've been trying to get the resize vba to work.
I need 3 columns (Q,R,S) to be copied and pasted after column 19. This has to happen until the number of 3 column sets (i, copies of Q:S) is equal to the value in cell ("C18"), likewise, if the number of repeats of QRS is greater than the value in C18 the unnecessary copies should be deleted.
The resize worked fine when it was just one column but now that I try to get a set of 3 added or deleted it goes wrong..the number of copies is not equal to the value in ("C18") and the number of copies made or deleted is not constant when I rerun the sub.
Does anyone have a solution?
Sub resize()
Dim SLastCol As Long
Dim i As Long
i = Range("C18").Value * 3
SLastCol = Cells(1, Columns.Count).End(xlToLeft).Column - 19
If SLastCol < i Then
Columns("Q:S").EntireColumn.copy
Columns("T").EntireColumn.Resize(, Abs(SLastCol - i)).Insert shift:=xlToRight
ElseIf SLastCol > i Then
Columns("T:W").EntireColumn.Resize(, Abs(SLastCol - i)).Delete shift:=xlToLeft
End If
Application.CutCopyMode = False
End Sub
Please, test the next code. It will copy all columns in the range colsRng, as many times as is written in "C8":
Sub resizeColumnsCopy()
Dim i As Long, colsRng As Range, lastCol As Long, rngDel As Range, arrCols, arrPrevCols
'identify the previous processed columns and delete them, if any
lastCol = cells(1, Columns.count).End(xlToLeft).Column
arrPrevCols = Range(cells(1, 20), cells(1, lastCol)).Value 'place the headers after column 20 in an array
arrCols = Range("Q1:S1").Value 'do the same with the copied columns headers
For i = 1 To UBound(arrPrevCols, 2) Step 3 'iterate in the larger array, from three to three columns
If arrPrevCols(1, i) = arrCols(1, 1) Then 'finding the first column header
If rngDel Is Nothing Then
Set rngDel = Range(cells(1, 19 + i), cells(1, 19 + i + 2)) 'create a range of the three involved columns
Else
Set rngDel = Union(rngDel, Range(cells(1, 19 + i), cells(1, 19 + i + 2))) 'careate a Union between the previous range and the next three
End If
End If
Next i
If Not rngDel Is Nothing Then rngDel.EntireColumn.Delete 'if cases of processed columns found, then delete the columns
i = Range("C18").Value
Set colsRng = Columns("Q:S")
colsRng.Copy
cells(1, colsRng.Column + colsRng.Columns.count).EntireColumn.resize(, i * colsRng.Columns.count).Insert Shift:=xlToRight
Application.CutCopyMode = False
End Sub
But, please edit your question and explain about the necessity of previous processed columns deletion. Otherwise, somebody else looking to my code will think that I recently hit my head...
I'm a complete novice at macro programming in excel. I have an excel file with over 1000 lines of data and would like to delete the entire row when the data in column 44 is repeated in consecutive rows. I've attached the script that I've been trying to tweak to no avail.
Currently the script deletes most of the duplicate rows but not all and I can't figure out why.
Sub deleteDupes()
Dim i As Long
With Sheets("Sheet1")
For i = .Cells(Rows.Count, 1).End(xlUp).row To 2 Step -1
If .Cells(i, 44).Value = .Cells(i - 1, 44).Value Then _
.Rows(i).Delete
Next i
End With
End Sub
You should delete the rows all at once rather than at each line. You can use the UNION method to accomplish this. This WILL successfully do what you are describing. If you have issues it has to do with your data.
More importantly, this will make your procedure one MUCH faster.
Sub deleteDupes()
Dim i As Long
With Sheets("Sheet1")
Dim killRng As Range
Set killRng = Rows(Rows.Count)
For i = .Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
If .Cells(i, 44).Value = .Cells(i - 1, 44).Value Then _
Set killRng = Union(Rows(i), killRng)
Next i
End With
killRng.EntireRow.Delete
End Sub
I am trying to create a rolling twelve month sum in excel using vb. The last column with data is dynamic so I created a variable to store that column number each time. I then tried to create a loop that would output the sum of the previous 12 cells and move to the next cell until it reached 12 calculation cells. But this is not working... Is there something obvious that I am doing wrong?? Thanks!
Sub OSR_ReportComplete()
Dim lCol As Long
Dim p As Integer
lCol = Cells(7, Columns.Count).End(xlToLeft).Column
For p = 0 To 12
Range(Cells(15, lCol - p)).Value = Application.Sum(Range(Cells(7, lCol -
p), Cells(7, lCol - p - 12)))
Next p
End Sub
Could be done in a neater way but this works
Sub OSR_ReportComplete()
Dim lCol As Long
Dim p As Integer
lCol = Cells(7, Columns.Count).End(xlToLeft).Column
For p = 0 To 12
Cells(15, lCol - p) = Application.Sum(Range(Cells(7, lCol - p), Cells(7, lCol - p - 12)))
Next p
End Sub
Also, If your lCol evaluates to a value less then 25 it will fall over though due to trying to reference a column less than 1. I'd recommend using Offset instead
However, a rolling total can be done very easily in excel formulas also. Say your first value is in Column A and your date is in row 1, in row 2 enter in Column A =SUM($A$1:A1) and drag along the rest of your range
Giving:
Formulas:
The following code will generate the formulas above for row 1 in one line instead of doing your loop. This is an example as I don't understand the layout of your sheet from your code
Sub OSR_ReportComplete2()
With Range(Cells(1, 1), Cells(1, Columns.Count).End(xlToLeft))
.Offset(1, 0).Formula = "=SUM(" & .Cells(1).Address & ":" & Split(.Cells.Address(RowAbsolute:=False, ColumnAbsolute:=False), ":")(0) & ")"
End With
End Sub
This is easier to write in R1C1 notation (however will be displayed in A1 in Excel Sheet)
Sub OSR_ReportComplete2()
With Range(Cells(1, 1), Cells(1, Columns.Count).End(xlToLeft))
.Offset(1, 0).FormulaR1C1 = "=SUM(" & .Cells(1).Address(ReferenceStyle:=False) & ":R[-1]C)"
End With
End Sub
First of all, I suggest you don't use VBA for this. Instead, use the inbuilt OFFSET function, like this.
Your code is quite complex, but maybe you should be using xlToRight instead of xlToLeft to find the last column.
If you want to use VBA, you can try using WorkSheetFunction.offset, putting it into a range variable and then summing that range.
I was trying to do an automation and i was stuck here, where i need to add sum formula dynamically in between the space ranges. I'm completely lost here for adding formula using VBA can anyone help me out.
Thank you in advance :)
I'm assuming what you want is if there is a blank in a cell, you want all of the other elements summed and the result placed in that blank. There are probably any number of ways to code this, but here is my attempt
Sub formulateSubtotals()
finalRow = Cells(Worksheets("Sheet1").Rows.Count, 1).End(xlUp).Row
finalCol = Cells(1, Worksheets("Sheet1").Columns.Count).End(xlToLeft).Column
For j = 1 To finalCol
For i = finalRow + 1 To 1 Step -1
If IsEmpty(Cells(i, j)) Then
If IsEmpty(Cells(i - 2, j)) Then
firstRow = i - 1
lastRow = firstRow
Else
lastRow = i - 1
firstRow = Cells(i - 1, j).End(xlUp).Row
End If
Cells(i, j) = Application.WorksheetFunction.Sum(Range(Cells(firstRow, j), Cells(lastRow, j)))
End If
Next i
Next j
End Sub
This also assumes that the sheet in question is entitled "Sheet1".
Without VBA:
Say we have data in column A like:
and we want to calculate of sum of each of the blocks separated by a blank cell. In B2 enter:
=IF(A2<>"","",SUM($A$1:A2)-SUM($B$1:B1))
and copy down:
If this is of no value, I will delete the answer.