I want to run a code that will go down all of column D (D:D) in my sheet named PxV and if they find a blank cell it will completely delete that corresponding row. Another caveat is idk if my cells are truly blank? There is a formula running through all the cells and if it is false returns "". Idk if this would be recognized as blank by VBA so if you would have to delete cells that have "" even though they're blank. It would also be nice to run continuously so when new data is populates it runs but I am not sure if that is possible . Thanks!!!
See if this works. You'll need to edit the code to match your sheet name and column.
Sub DelRow()
Dim ws As Worksheet
Dim SheetsToSearch, SrchStrg As String, r As Range
Set ws = Sheets("Sheet1")
SrchStrg = ""
SrchStrg2 = 0
Application.ScreenUpdating = False
With ws.Range("A:A")
Set r = .Find(what:=SrchStrg, After:=.Range("A1"))
For Each r In ws.Range("A1:A1000")
If r = SrchStrg Then
r.EntireRow.Delete
ElseIf r = SrchStrg2 Then
r.EntireRow.Delete
End If
Next
End With
Application.ScreenUpdating = True
End Sub
Related
I am new to coding in anything, this project is the first time I have coded. I am trying to hide multiple row based on individual requirement. The requirement is if in a specific cell of the same row there is a space or is empty, the row will be hidden, if it is hidden and there is anything else, the row will be shown. The code need to work on specific worksheet as I have multiple worksheet where there is row to hide or columns to hide at different place.
There are 2 different pieces of code that I tried which don't work.
This picture represent the Excel sheet I am currently trying to hide row:
My goal is to hide row between 8 to 37 if there is there is a space or if it is empty, depending what the code inside the cell point at for the cell A8 to A37. if I activate the code, in the image only the row 8, 9 and 10 should be visible, 11 to 37 should be hidden.
So far I have tried these two pieces of code:
Sub C1()
Set ws = ActiveWorkbook.Worksheets("FR-3-06_Jeux Prod.")
Dim C As range
For Each C In range("A8:A37")
If C.Value = " " Then
C.EntireRow.Hidden = True
Else
If C.Value = Empty Then
C.EntireRow.Hidden = True
Else
C.EntireRow.Hidden = False
End If
End If
Next C
End Sub
This code work as intended except that it is not tied to a sheet. "Set ws = ActiveWorkbook.Worksheets("FR-3-06_Jeux Prod.")" is not working as well as a couple other code I tried, they point to an error. So when I try to use this code it will work on the active sheet and not "FR-3-06_Jeux Prod."
Sub Hide_column_and_Row_F_3_6()
Dim NbreLigne As Integer
Dim tableau As range
Set wrkshtDoc = ActiveWorkbook.Worksheets("FR-3-06_Jeux Prod.")
Set tableau = wrkshtDoc.range("A8:A37")
NbreLigne = tableau.Rows.Count
For k = 1 To NbreLigne
If tableau(1, k) = " " Then
tableau(1, k).EntireRow.Hidden = True
ElseIf tableau(1, k) = Empty Then
tableau(1, k).EntireRow.Hidden = True
Else
tableau(1, k).EntireRow.Hidden = False
End If
Next k
End Sub
This code only works as intended when I try to hide columns as in replace "row" in the code with "columns". There is sheet in my file where is it columns I need to hide and since this code is working I tried to reuse it... what it is currently doing is hiding row with "test", line 8 only. It wont hide the empty cell.
what would be the error or what would be needed to hide row with the requirement? I know that code #2 work with columns...
You are almost there with code1, you only need to add:
For each C in ws.Range("A8:A38")
Because you add ws. in front of the Range, it knows which sheet to apply it on.
Good luck!
Hide Blank Rows
Option Explicit
Sub HideBlankRows()
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
Dim ws As Worksheet: Set ws = wb.Worksheets("FR-3-06_Jeux Prod.")
Dim Cell As Range
For Each Cell In ws.Range("A8:A37").Cells
Cell.EntireRow.Hidden _
= IIf(Len(Trim(CStr(Cell.Value))) = 0, True, False)
Next Cell
End Sub
I need to create a summary page that will report ONLY tabs that contain conditional formatting that's true. So Tab1 contains a comparison of Before and After; the After will highlight any cells that are different than the Before; then the macro loops to do this with a new tab for every .jbi file in a folder. So each .jbi will have a copy of Tab1 named differently. I'm not sure which method would be better to identify tabs with highlighted changes on a summary page nor really how to go about searching each tab for them.
So my questions are - Should I 1.) make it part of the .jbi import loop where it creates a new copy of Tab1, pastes the before and after data, then resets the template 2.) have it look for changes once it has completed creating new tabs?
3.) How do I get it to search for true conditional formats either way?
Edit: Using the suggestion in the first comment, this is what I came up with, but it doesn't work. It never copies the values
Sub Create_summary()
Dim inputarea As Range
Set inputarea = Sheets("PGM Copy Template").Range("AF2:BA1000")
If inputarea.DisplayFormat.Interior.ColorIndex = 49407 Then
Sheets("Change Summary").Select
Rows("3:3").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
If Sheets("PGM Copy Template").Range("F4").Value = "#N/A" Then
Sheets("Change Summary").Range("B3").Text = Sheets("PGM Copy Template").Range("AI5").Text
Sheets("Change Summary").Range("C3").Text = Sheets("PGM Copy Template").Range("AI4").Text
Else
Sheets("Change Summary").Range("B3").Text = Sheets("PGM Copy Template").Range("F5").Text
Sheets("Change Summary").Range("B3").Text = Sheets("PGM Copy Template").Range("F4").Text
End If
Else
Exit Sub
End If
End Sub
I guess I need help understanding how I can make the If/then function with the search.
A bit easier to split out the check for the CF color:
Sub Create_summary()
Const CHECK_COLOR As Long = 49407 'use Const for fixed values
Dim inputarea As Range, wb As Workbook, wsInput As Worksheet, c As Range
Dim wsSummary As Worksheet, isNA As Boolean
Set wb = ThisWorkbook 'ActiveWorkbook? 'use a workbook variable
Set wsInput = wb.Worksheets("PGM Copy Template") 'use worksheet variables
Set wsSummary = wb.Worksheets("Change Summary")
If HasCfColor(wsInput.Range("AF2:BA1000"), CHECK_COLOR) Then
isNA = wsInput.Range("F4").Value = "#N/A"
With Sheets("Change Summary")
.Rows(3).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
.Range("B3").Text = wsInput.Range(IIf(isNA, "AI5", "F5")).Text
.Range("C3").Text = wsInput.Range(IIf(isNA, "AI4", "F4")).Text
End With
End If
End Sub
'Does range `rngToCheck` contain a cell with CF coloring of `cfColor` ?
Function HasCfColor(rngToCheck As Range, cfColor As Long)
Dim rng As Range, c As Range
On Error Resume Next 'ignore error if no CF in this range
Set rng = rngToCheck.SpecialCells(xlCellTypeAllFormatConditions) 'only cells with CF
On Error GoTo 0 'stop ignoring errors
If Not rng Is Nothing Then 'True if have any cells with CF
For Each c In rng.Cells
If c.DisplayFormat.Interior.Color = cfColor Then
HasCfColor = True
Exit Function 'done checking
End If
Next c
End If
HasCfColor = False
End Function
I have a slicer (based on a table), I would like to create a macro in order that when I select any single value in my slicer, the macro selects and copies automatically the second visible cell in column D (for example if I select the value X13 in my slicer, I want that my macro selects and copies automatically the second visible cell in column D). The part of my VBA code to select and copy the second visible cell in column D works perfectly but it does not work when I select a single value in my slicer (I assigned the macro related to my slicer). I do not know which line of VBA code that I need to add add for my macro works when I select any single value in my slicer. Please find my VBA code below.
Sub NextVisiblecellassignedtomyslicer()
Dim r As Range
Set r = Range("D1")
For i = 1 To Rows.Count
Set r = r.Offset(1, 0)
If r.EntireRow.Hidden = False Then
r.Copy
Exit Sub
End If
Next
End Sub
I finally managed to find the solution to my problem by myself:
Sub NextVisiblecellassignedtomyslicer()
Dim slr As Slicer
Dim si As SlicerItem
Dim i As Long
Dim it As Object
Set sc = ActiveWorkbook.SlicerCaches("Slicer_WBS_element")
With sc
For Each it In .SlicerItems
If it.Selected = True Then
call nextvisiblecellV10
End If
Next it
End With
End Sub
Sub nextvisiblecellV10()
Dim r As Range
Set r = Range("D1")
For i = 1 To Rows.Count
Set r = r.Offset(1, 0)
If r.EntireRow.Hidden = False Then
r.Copy
Exit Sub
End If
Next
End Sub
I need to write a function to color a bunch of cells in one row based on the colors of cells in another row. I've tried some different VBA variations, but this is what I am wanting to do:
Public Function CopyColorFormat(Target As Range)
If Not Target.Interior.Color Is Nothing Then
ActiveCell.Interior.ThemeColor = Target.Interior.ThemeColor
End If
End Function
I then went to A1 and set the formula to =CopyColorFormat(C1). (C1 is Purple and I want A1 to also be shaded Purple.) However, this results in a #VALUE! error in the cell I try to put the function in.
The reason I am wanting this and not to use conditional formatting is that I need to apply this to a ton of cells (via their corresponding cell) and dont want to make a rule for each one.
I don't know much about functions, but this macro should do the trick for you.
Sub color_cells()
Application.ScreenUpdating = False
Dim currentcell As Range
Dim copycell As Range
Dim current As Long
Dim copy As Long
Set currentcell = Range("A1")
Set copycell = Range("C1")
current = 1
copy = 1
For x = 1 To 8 ' instead of 8 - enter the number of rows you want the code to run on.
If Not copycell.Interior.ColorIndex = xlNone Then
copycell.copy
currentcell.PasteSpecial xlPasteFormats
End If
current = current + 1
copy = copy + 1
Set currentcell = Range("A" & current)
Set copycell = Range("C" & copy)
Next x
Application.ScreenUpdating = True
End Sub
You might want to specify which workbook and worksheet the code runs on if you work with multiple at the same time.
I'd like to preface this by saying that I'm largely inexperienced with coding. I've been working on a project at work on my own, and finally ran into a wall that I can't solve by simple googling.
To explain briefly with pertinent details, I have a workbook with a varying number of worksheets that each have a specific cell for text (explained later), and a checkbox.
My goal is to select a range of cells, usually 1-5 in a row, and then have a button to change the color of the same selected cells of all sheets given a specific criteria. The criteria being that only the sheets that have "Office" listed in the aforementioned cell, and the check box un-checked, will be changed.
While I have no issue having Excel cycle through the sheets and do something only on the sheets that meet the criteria, the problem comes with trying to edit the same cells as are selected on the main sheet.
The coding I have come up with so far:
Dim cell As Range
Dim n As Integer
Set cell = Selection
If Range("AN6").Text = "Office" Then
For n = 1 To Sheets.Count - 2
If Sheets(n).Range("AN6").Text = "Office" And Sheets(n).CheckBox1.value = False Then
For Each cell In Selection
Sheets(n).Range(cell).Interior.ColorIndex = 56
Next cell
End If
Next n
End If
The error I am getting is: Application-defined or object-defined error.
Hopefully there is a way to execute this. I'd greatly appreciate any help I can get.
You can use the .Address property of a range. I'm pretty sure you're getting an error because your selection is in one sheet, and you try to refer to that range in another sheet. Using just the address of the range should fix that issue.
Dim cell As Range
Dim n As Integer
Set cell = Selection
If Range("AN6").Text = "Office" Then
For n = 1 To Sheets.Count - 2
If Sheets(n).Range("AN6").Text = "Office" And Sheets(n).CheckBox1.value = False Then
For Each cell In Selection
Sheets(n).Range(cell.Address(False,False)).Interior.ColorIndex = 56
Next cell
End If
Next n
End If
The only testing I did on this code was using this sub. I selected a range on my worksheet and ran the macro and the msg box said Q12:U26
Sub test()
Dim cell As Range
Set cell = Selection
MsgBox cell.Address(False, False)
End Sub
This should work:
Sub test()
With Selection
startRow = .Cells(1).Row
startColumn = .Cells(1).Column
endRow = .Cells(.Cells.Count).Row
endColumn = .Cells(.Cells.Count).Column
End With
If Range("AN6").Text = "Office" Then
For n = 1 To Sheets.Count - 2
If Sheets(n).Range("AN6").Text = "Office" And Sheets(n).CheckBox1.value = False Then
For Each cell In Range(Sheets(n).Cells(startRow, startColumn), Sheets(n).Cells(endRow, endColumn))
cell.Interior.ColorIndex = 56
Next cell
End If
Next n
End If
End Sub