I am having a set of records highlighting the keywords with regards to the dates they were raised. I want to remove the duplicates in the rows and analyze the frequency of keywords on a pivot table with regards to the month they were raised.
I have used python-3 code to chunk out the keywords from the customer queries that were logged in the system. I am not sure how to strip it.
Sub RemoveDuplicatesInRow()
Dim lastRow As Long
Dim lastCol As Long
Dim r As Long 'row index
Dim c As Long 'column index
Dim i As Long
With ActiveSheet.UsedRange
lastRow = .Row + .Rows.Count - 1
lastCol = .Column + .Columns.Count - 1
End With
For r = 1 To lastRow
For c = 1 To lastCol
For i = c + 1 To lastCol 'change lastCol to c+2 will remove adjacent duplicates only
If Cells(r, i) <> "" And Cells(r, i) = Cells(r, c) Then
Cells(r, i) = ""
End If
Next i
Next c
Next r
End Sub
The macro just doesn't work.
Related
please help i want to sort the name column such that each name starts after every blank cell.
I want it look something like this..pls help it's a pretty long column
Option Explicit
Sub SetNamePosition()
Dim arr As Variant
Dim i As Long: i = 1 ' for Loop
Dim j As Long: j = 1 ' for Array
Dim lastRow As Long: lastRow = Cells(Rows.Count, 1).End(xlUp).Row
Dim rngColB As Range: Set rngColB = Range("B2:B" & lastRow)
Dim rngNames As Range: Set rngNames = Range("C1") ' Temporary range
' Get column B names only
rngColB.SpecialCells(xlCellTypeConstants, 2).Copy
rngNames.PasteSpecial (xlPasteValues)
Application.CutCopyMode = False
Set rngNames = Range(rngNames, rngNames.End(xlDown))
' Load rngNames to array
arr = Application.Transpose(rngNames)
' Clear rng of column B and rngNames
rngColB.Clear
rngNames.Clear
' Insert names
For i = 2 To lastRow
' set name
Cells(i, 1).Offset(0, 1).Value = arr(j)
' find next cell
i = Cells(i, 1).End(xlDown).Row + 1
j = j + 1
Next i
End Sub
I's probably better to remove the empty ranges before making the array, but here's one way to distribute the names:
Loading the range ito an array, then go through the numbers and look for empty ranges.
This assumes that we are working with column "A" and "B" (1 and 2), starting at the top.
Sub test()
Dim arr As Variant
Dim lastRow As Long, i As Long, j As Long
lastRow = Cells(Rows.Count, "A").End(xlUp).Row
arr = Application.Transpose(Range("B2:B" & lastRow))
Range("B2:B" & lastRow).Clear
j = 1
For i = 2 To lastRow
Cells(i, 2) = arr(j)
j = j + 1
If j >= UBound(arr) Then Exit For
While arr(j) = "" And j < UBound(arr)
j = j + 1
Wend
While Not Cells(i, 1).Value = ""
i = i + 1
Wend
Next i
End Sub
Any leftover names will be removed
I have a table consisting of strings and numbers. Row one contains the heading and row two contains the unit type (percent and dollars). I would like to round the numbers in the column based on the heading in row two.
At the moment I am selecting the columns individually. Is there a way to round the column based on the heading in row two?
Sub Round()
Dim Lastrow As Long
Lastrow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row 'Determine
last row
For Each cell In ActiveSheet.Range("R3:R" & Lastrow)
cell.Value = WorksheetFunction.Round(cell.Value, 2) 'Round dollars to 2 places
Next cell
For Each cell In ActiveSheet.Range("AB3:AB" & Lastrow)
cell.Value = WorksheetFunction.Round(cell.Value, 2)
Next cell
For Each cell In ActiveSheet.Range("Q3:Q" & Lastrow)
cell.Value = WorksheetFunction.Round(cell.Value, 1) 'Round percentages to 1 places
Next cell
....
End Sub
You were close enough, just needed a bit from both of those tries together. Please see if the below helps, I've added an alternative using arrays as well (if you have lots of data, it will be much faster):
Sub RoundRanges()
Dim ws As Worksheet: Set ws = ActiveSheet 'better use something like: ActiveWorkbook.Sheets("Sheet name here")
Dim lRow As Long: lRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row 'get last row
Dim lCol As Long: lCol = ws.Cells(2, ws.Columns.Count).End(xlToLeft).Column 'get last column
Dim R As Long, C As Long
For C = 1 To lCol 'iterate through each column
Select Case ws.Cells(2, C) 'get the text of the cell 2...
Case "Percent"
For R = 3 To lRow 'iterate through each row
ws.Cells(R, C) = WorksheetFunction.Round(ws.Cells(R, C).Value, 1) 'apply the desired calculation
Next R
Case "Dollars"
For R = 3 To lRow 'iterate through each row
ws.Cells(R, C) = WorksheetFunction.Round(ws.Cells(R, C).Value, 2) 'apply the desired calculation
Next R
End Select
Next C
'ALTERNATIVE:
'Dim arrData As Variant: arrData = ws.Range(ws.Cells(1, 1), ws.Cells(lRow, lCol))
'For R = LBound(arrData) + 2 To UBound(arrData) 'skip first 2 rows
' For C = LBound(arrData, 2) To UBound(arrData, 2)
' If arrData(2, C) = "Percent" Then
' arrData(R, C) = Round(arrData(R, C), 1)
' ElseIf arrData(2, C) = "Dollars" Then
' arrData(R, C) = Round(arrData(R, C), 2)
' End If
' Next C
'Next R
'ws.Range(ws.Cells(1, 1), ws.Cells(lRow, lCol)) = arrData
End Sub
If anyone has done anything like below please help.
What I'm looking for is macro that looks at my A2 value and copy that in column D based on value B with "_"(underscore) after it.
You would need 2 loops for this. One looping through column A and one counting up to the value in column B.
Option Explicit
Public Sub WriteValues()
With Worksheets("Sheet1")
Dim aLastRow As Long
aLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row 'get last used row in col A
Dim dRow As Long
dRow = 1 'start row in col D
Dim aRow As Long
For aRow = 1 To aLastRow 'loop through col A
Dim bCount As Long
For bCount = 1 To .Cells(aRow, "B").Value 'how many times is A repeated?
.Cells(dRow, "D").Value = .Cells(aRow, "A") & "_" & bCount 'write into column D
dRow = dRow + 1 'count rows up in col D
Next bCount
Next aRow
End With
End Sub
Your request is little short on particulars but this will do what you're asking.
dim i as long
with worksheets("sheet1")
for i=1 to .cells(2, "B").value2
.cells(.rows.count, "D").end(xlup).offset(1, 0) = .cells(2, "A").value & format(i, "\_0")
next i
end with
I found the code below over here: Insert row below based on cell value excel macro
It works but, like the poster in the other message, I want the new row to be inserted below the existing row (here the row with a "2" in it), rather than above. I've tried changing Shift:=xlDown to xlUp but that has no effect. What am I missing something?
Sub BlankLine()
Dim Col As Variant
Dim BlankRows As Long
Dim LastRow As Long
Dim R As Long
Dim StartRow As Long
Col = "C"
StartRow = 1
BlankRows = 1
With ActiveSheet
For R = LastUsedRow() To StartRow + 1 Step -1
If .Cells(R, Col) = "2" Then
.Cells(R, Col).EntireRow.Insert Shift:=xlDown
End If
Next R
End With
End Sub
To insert the row below R use R + 1. Is this what you are trying?
Dim R As Long, LastRow As Long
LastRow = LastUsedRow()
With ActiveSheet
For R = LastRow To 2 Step -1
If .Range("C" & R).Value = 2 Then _
.Range("C" & R + 1).EntireRow.Insert Shift:=xlDown
Next R
End With
Situation: I have data that I am trying to consolidate by summing rows based on the first column value (item ID number). If the ID numbers match I want the rows to be added together and the duplicate rows deleted.
I have written the following code and I am experiencing 2 issues: 1. The first time I run the code there is always a few duplicates left that were not consolidated 2. If I run the code again it sums and deletes rows even if they are not duplicates.
Any help would be much appreciated.
Sub ConsolidateRows()
Dim WB As Workbook
Dim WS As Worksheet
Dim iRow As Long
Dim iCol As Long
Dim LastRow As Long
Dim LastCol As Long
Dim duplicate As String
Dim dupRow As Long
Dim cell As Range
Dim i As Integer
'set
Set WB = Workbooks("Book1")
Set WS = WB.Sheets("Data")
LastRow = WS.UsedRange.Rows.Count
LastCol = WS.UsedRange.Columns.Count
'Loop to consolidate, delete the duplicate rows
iRow = 1
While WS.Cells(iRow, 1).Value <> ""
duplicate = Cells(iRow, 1).Value
iRow = iRow + 1
For Each cell In WS.Range("A1:A" & LastRow).Cells
dupRow = cell.Row
If cell.Value = duplicate And iRow <> dupRow Then
For iCol = 3 To LastCol
Cells(iRow, iCol) = Application.WorksheetFunction.Sum(Cells(iRow, iCol), Cells(dupRow, iCol))
Next iCol
WS.Rows(dupRow).Delete
End If
Next cell
Wend
End Sub
When deleting rows, always start at the bottom and work your way up.
For example if Column A for rows 1-5 contain:
Alpha
Bravo
Charlie
Delta
Foxtrot
and you delete row 3, you now have
Alpha
Bravo
Delta
Foxtrot
Your loop counter (value 3) was pointing at Charlie before the deletion, but is now pointing at Delta, you then increment your counter to 4, and it's pointing at Foxtrot, therefore you never evaluated whether you needed to delete Delta.
Try this:
'Loop to consolidate, delete the duplicate rows
iRow = LastRow
While WS.Cells(iRow, 1).Value <> ""
duplicate = Cells(iRow, 1).Value
iRow = iRow - 1
For Each cell In WS.Range("A1:A" & LastRow -1).Cells
dupRow = cell.Row
If cell.Value = duplicate And iRow <> dupRow Then
For iCol = 3 To LastCol
Cells(iRow, iCol) = Application.WorksheetFunction.Sum(Cells(iRow, iCol), Cells(dupRow, iCol))
Next iCol
WS.Rows(dupRow).Delete
LastRow = LastRow - 1
End If
Next cell
Wend
*Note: code changes off the top of my head, you may have to make some minor additional tweaks to get it running backwards
Also, please investigate .Find() - it will make your code run significantly faster for finding dups.