I found the following code to hide duplicate rows:
For i = Last_Row To First_Row Step -1
If WorksheetFunction.CountIf(Range("F" & First_Row & ":F" & i), Range("F" & i).Value) > 1 Then Rows(i).Hidden = True
Next I
The code works great, but I'm using it in a Table so I'd like to replace the fixed column "F" with a table header reference. That way if someone inserts columns it will still work. I'm struggling to find the right syntax.
My table and column is:
Range("PART_SELECTION_DATABASE[PART '#]")
Any help is appreciated.
You can use Find function to look for the header PART '#".
Once it's found, you can extract the column number using FindRng.Column.
Code
Option Explicit
Sub FindHeader()
Dim FindRng As Range
Dim HeadrStr As String
Dim Col As Long
HeadrStr = "PART '#"
Set FindRng = Cells.Find(what:=HeadrStr)
If Not FindRng Is Nothing Then . make sure Find was successful
Col = FindRng.Column ' get the column number
Else ' Find failed to find the Header
MsgBox "unable to find " & HeadrStr, vbCritical
Exit Sub
End If
For I = Last_Row To First_Row Step -1
If WorksheetFunction.CountIf(Range(Cells(First_Row, Col), Cells(I, Col)), Cells(I, Col).Value) > 1 Then Rows(I).Hidden = True
Next I
End Sub
Related
I have a Macro that loops through one column that hold dates that are not random (they go vertically from old to more recent ),then finds every date that is greater than Now () then goes to its adjacent cells and clears them
it works fine , except that the looping takes a small bit of time, which i believe could me much faster if the Macro wouldn't loop against all values in the column(500 rows) but instead just stops at the first cell match , then goes to its adjacent cells and clear all contents from that row till the bottom of the table ( ie if the match is at row 15 , then it clear contents from row 15 all the way down to 500 ) without having to check every single row
The code below as described is designed to loop through every value , i need it to stop at the first match and clear contents of adjacent cells underneath in the range the macro covers
can somone please help me acheive this
Dim R As Long
For R = 1 To 500
If Cells(R, "A").Value >= Now Then Cells(R, "B").Value = ""
If Cells(R, "A").Value >= Now Then Cells(R, "C").Value = ""
Next
End Sub
Using your methodology, if you want to know how to drop out of a loop once the criteria are matched - you would use an Exit For. You also can clear column B and C at the same time, like so:
Dim R As Long
With ActiveWorkbook.Sheets("Sheet1")
For R = 1 To 500
If .Cells(R, "A").Value >= Now Then
.Range("B" & R & ":C500").ClearContents
Exit For
End If
Next
End With
In the above, I've also added reference to the sheet. This is always good practice to prevent possible errors once more than one sheet is available.
Here's an example with a binary search.
Option Explicit
Public Sub ClearByDates(Optional targetDate As Variant = Null)
Dim thisSheet As Worksheet
Dim activeRange As Range
Dim lowerRow As Long, higherRow As Long, thisRow As Long
Dim thisDate As Date
' If no date is provided, assume today is the cutoff
If IsNull(targetDate) Then targetDate = Date
' Assuming that we're putting this code in the worksheet that you want to _
clear. If you decide to put it in a separate module you can either: _
(1) Pass in the worksheet you want to modify as an argument, or _
(2) Explicitly set the worksheet you want to modify using ActiveWorkbook.Worksheets(Name)
Set thisSheet = Me
Set activeRange = thisSheet.UsedRange
With activeRange
' Not only is it cleaner if you use With, you get better performance in VBA _
because it's a hint that the object should be kept loaded and ready.
' Getting the range of rows with values
lowerRow = .Rows(1).Row
higherRow = lowerRow + activeRange.Rows.Count - 1
' Don't start processing until you're in the date range; _
this should handle most common worksheet header situations.
Do Until IsDate(activeRange.Cells(lowerRow, 1))
lowerRow = lowerRow + 1
If lowerRow > higherRow Then Exit Sub
Loop
' Use a binary search to find the first row where the date is _
greater than or equal to the target date.
Do Until lowerRow >= higherRow - 1
thisRow = (higherRow + lowerRow) / 2
thisDate = .Cells(thisRow, 1)
Debug.Print "Row " & Right(" " & thisRow, 7) & ": " & Format(thisDate, "YYYY-MM-DD") & " ";
If thisDate >= targetDate Then
Debug.Print ">= " & Format(targetDate, "YYYY-MM-DD");
higherRow = thisRow
Else
Debug.Print "< " & Format(targetDate, "YYYY-MM-DD");
lowerRow = thisRow
End If
Debug.Print " (lowerRow = " & lowerRow & ", higherRow = " & higherRow & ")"
Loop
' Assuming we just want to clear columns B & C. This can easily be adjusted _
to clear all columns to the right by using .Columns(.Columns.Count) in the _
ending range.
thisSheet.Range("B" & thisRow & ":C" & .Rows(.Rows.Count).Row).ClearContents
End With
End Sub
Hi I'm trying to create a VBA code that fills the entire column G values with Column E - Column F (so E2-F2 = G2) but I keep getting mismatch error. The values start from the second row and I have created a loop to run down the columns.
This is the code I have so far.
Sub RemainingHours()
Dim i As Integer
i = 2
With Sheets("Opt")
While Not IsEmpty(Cells(5, i).Value)
Cells(7, i).Value = Cells(6, i).Value - Cells(5, i).Value
i = i + 1
Wend
End With
End Sub
Thank you!
Rather than looping you could try using Evaluate.
Sub RemainingHours()
Dim rng As Range
Dim Res As Variant
With Sheets("Opt")
Set rng = .Range("E2", .Range("E" & Rows.Count).End(xlUp))
End With
Res = Evaluate(rng.Offset(, 1).Address & "-" & rng.Address)
rng.Offset(, 2).Value = Res
End Sub
I want to create a userform that can find the "Sales" value in column E and then input the remaining data to the same row.
Set APAC = Sheet2
APAC.Activate
Range("E18:E1888").Select
For Each D In Selection
If D.Value = "TWO.Sales.Value" Then
Exit For
End If
Next D
Rows(D.Row).Select
D.Offset(0, 2).Value = TWO.RSA.Value
D.Offset(0, 3).Value = TWO.Part.Value
D.Offset(0, 4).Value = Application.WorksheetFunction.VLookup(TWO.Part.Value, Worksheets("DataEntry").Range("T2:U70").Value, 2, False)
D.Offset(0, 5).Value = TWO.Program.Value
D.Offset(0, 6).Value = TWO.QTY.Value
Sheet2.Activate
This is my code but
run time error '91'
occurs.
I am having error on the "Rows(D.Row).select" line – Jacob 2 mins ago
That means "TWO.Sales.Value" was not found in Range("E18:E1888") and hence D was nothing. You need to check if the value was found. Also I have a feeling that you wanted If D.Value = TWO.Sales.Value Then instead of If D.Value = "TWO.Sales.Value" Then
Also there is no need to Select/Activate. You can directly work with the objects. You may want to see How to avoid using Select in Excel VBA
Whenever you are working with VLookup, it is better to handle the error that may pop up when a match is not found. There are various ways to do it. I have shown one way in the code below.
Is this what you are trying? (UNTESTED)
Option Explicit
Sub Sample()
Dim APAC As Worksheet
Dim curRow As Long
Dim aCell As Range
Dim Ret
Set APAC = Sheet2
With APAC
For Each aCell In .Range("E18:E1888")
If aCell.Value = TWO.Sales.Value Then
curRow = aCell.Row
Exit For
End If
Next aCell
If curRow = 0 Then
MsgBox "Not Found"
Else
.Range("G" & curRow).Value = TWO.RSA.Value
.Range("H" & curRow).Value = TWO.Part.Value
On Error Resume Next
Ret = Application.WorksheetFunction.VLookup(TWO.Part.Value, _
Worksheets("DataEntry").Range("T2:U70").Value, 2, False)
On Error GoTo 0
If Ret <> "" Then .Range("I" & curRow).Value = Ret
.Range("J" & curRow).Value = TWO.Program.Value
.Range("K" & curRow).Value = TWO.QTY.Value
End If
End With
End Sub
NOTE: If the range .Range("E18:E1888") is dynamic then you may want to find the last row as shown HERE and then use the range as .Range("E18:E" & LastRow)
so i have Sheet1 that is use to contain the list of my inventory data. what i want to do is in another sheet(Sheet2). i can search my Sheet1 data and display the data there ( for example when i type cheetos, only the cheetos item got display ). Help me guys, using VBA is okay or other method is also fine.
If your results don't have to be on a different sheet, you could just convert your data to a Table. Select Cells A1:D8 and click on Insert -> Table. Make sure "My table has headers" is clicked and voila!
Once formatted as a table, you can filter Product ID however you need.
If you do need to show these results in another sheet, VBA would be my go-to solution. Maybe something like this:
Public Sub FilterResults()
Dim findText As String
Dim lastRow As Long
Dim foundRow As Long
Dim i As Long
'If there's nothing to search for, then just stop the sub
findText = LCase(Worksheets("Sheet2").Range("D4"))
If findText = "" Then Exit Sub
'Clear any old search results
lastRow = Worksheets("Sheet2").Cells(Rows.Count, 4).End(xlUp).Row
If lastRow > 5 Then
For i = 6 To lastRow
Worksheets("Sheet2").Range("C" & i).ClearContents
Worksheets("Sheet2").Range("D" & i).ClearContents
Worksheets("Sheet2").Range("E" & i).ClearContents
Worksheets("Sheet2").Range("F" & i).ClearContents
Next i
End If
'Start looking for new results
lastRow = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
foundRow = 6
For i = 2 To lastRow
If InStr(1, LCase(Worksheets("Sheet1").Range("B" & i)), findText) <> 0 Then
Worksheets("Sheet2").Range("C" & foundRow) = Worksheets("Sheet1").Range("A" & i)
Worksheets("Sheet2").Range("D" & foundRow) = Worksheets("Sheet1").Range("B" & i)
Worksheets("Sheet2").Range("E" & foundRow) = Worksheets("Sheet1").Range("C" & i)
Worksheets("Sheet2").Range("F" & foundRow) = Worksheets("Sheet1").Range("D" & i)
foundRow = foundRow + 1
End If
Next i
'If no results were found, then open a pop-up that notifies the user
If foundRow = 6 Then MsgBox "No Results Found", vbCritical + vbOKOnly
End Sub
I would recommend avoiding VBA for this process as it can be done easily with excel's functions. If you would like to do it via VBA one could just loop through the list of products and find a key word, adding it to an array if the "Cheetos" is contained in the specific cell value using a wildcard like so:
This could be modified to run upon the change of the D4 cell if needed, and of course some modifications could be done to ensure that formatting etc can be done to your liking.
Sub test()
Dim wb As Workbook
Dim rng As Range, cell As Range
Dim s_key As String, s_find() As String
Dim i As Long
Set wb = Application.ThisWorkbook
Set rng = wb.Sheets("Sheet1").Range("B2:B8")
s_key = wb.Sheets("Sheet2").Range("D4").Value
wb.sheets("Sheet2").Range("C6:F9999").clearcontents
i = 0
For Each cell In rng
If cell.Value Like "*" & s_key & "*" Then
ReDim Preserve s_find(3, i)
s_find(0, i) = cell.Offset(0, -1).Value
s_find(1, i) = cell.Value
s_find(2, i) = cell.Offset(0, 1).Value
s_find(3, i) = cell.Offset(0, 2).Value
i = i + 1
End If
Next cell
wb.Sheets("Sheet2").Range("C6:F" & 5 + i).Value = Application.WorksheetFunction.Transpose(s_find)
End Sub
I have a sheet that I want to check the language in Column R for <> ‘Cash’; if ‘Cash’ do skip to the next row. If Column R <> ‘Cash’, check Column A for duplicate ID (there may or may not be duplicates). If duplicates are found, I want to check Column K for positive/negative values, like 100000 & -100000, then delete the entire row where the negative value appears in Column K. How can I do that?
Following the roles described above, row 6 would be deleted in the image below.
I could use VBA in Excel, or SQL/VBA in Access.
This seems to work pretty well.
Sub TryMe()
Dim i As Long
Dim j As Long
Dim ws As Worksheet
Set ws = Sheet1
For i = 2 To 13
For j = 2 To 13
If ws.Range("A" & i).Value = ws.Range("A" & j).Value Then
If ws.Range("A" & i).Offset(0, 10).Value = -(ws.Range("A" & j).Offset(0, 10).Value) Then
If ws.Range("A" & i).Offset(0, 17).Value <> "Cash" Then
Rows(i).EntireRow.Delete
End If
End If
Exit For
End If
Next j
Next i
End Sub