How can I hide rows based off multiple column values? Example: If the "Projects", "Team Member", "Priority", & "Status" fields are all blank, then the row will hide itself.
I saw your other post, and I don't really think this is the way you should go about building your dashboard. You are essentially creating a copy of your other sheet. It seems like an Advance Filter would be better suited here.
If you are set on your current method, this will determine lowest used cell in your columns, and hide rows above that cell based on your criteria. I would add a command button named something like "Refresh My Dash" and link it to this macro.
Option Explicit
Sub HideRow()
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")
Dim LRowC, LRowD, LRowF, LRowH, LRow As Long
LRowC = ws.Range("C" & ws.Rows.Count).End(xlUp).Row
LRowD = ws.Range("D" & ws.Rows.Count).End(xlUp).Row
LRowF = ws.Range("F" & ws.Rows.Count).End(xlUp).Row
LRowH = ws.Range("H" & ws.Rows.Count).End(xlUp).Row
LRow = Application.WorksheetFunction.Max(LRowC, LRowD, LRowF, LRowH)
Dim i As Long
Application.ScreenUpdating = False
ws.Rows.Hidden = False
For i = LRow To 2 Step -1
If ws.Range("C" & i).Text = "" And ws.Range("D" & i).Text = "" And ws.Range("F" & i).Text = "" And ws.Range("H" & i).Text = "" Then
ws.Rows(i).EntireRow.Hidden = True
End If
Next i
Application.ScreenUpdating = True
End Sub
Related
I am trying to create a macro button that will help me update the the value in the AE column to "N" if the value in the same row of the H column is "REPO".
I am not sure why my code doesn't work properly and just seems to select the AE column when I run it instead of changing the values to "N"
Sub Change_Repo_Risk_to_N()
Sheets("expo").Select
Dim LastRow As Long
Dim i As Long
LastRow = Range("H" & Rows.Count).End(xlUp).Row
For i = 2 To LastRow
If Range("H" & i).Value = "REPO" Then
Range("AE" & i).Value = "N"
End If
Next i
End Sub
Probably mistake due to one if these 3:
Lack of Trim()
Lack of UCase() (Option Compare Text is an alternative of this one)
Select() is too slow and does not refer correctly to the worksheet (try to avoid it)
Try this one:
Sub ChangeRepoRiskToN()
With Worksheets("expo")
Dim lastRow As Long
Dim i As Long
lastRow = .Range("H" & Rows.Count).End(xlUp).Row
For i = 2 To lastRow
If Trim(UCase(.Range("H" & i).Value)) = "REPO" Then
.Range("AE" & i).Value = "N"
End If
Next i
End With
End Sub
I created my first userforms to capture hospital data but now I'm stuck.
I want to change all values for "Current inpatient" in column "B:B" from "yes" to "no" for a given patient when I click "Remove from ITU".
Example data
Userform to change patient from "Yes" to "no" in the "current inpatient" column
Try the next code, please:
Sub ChangeYesToNo()
Dim sh As Worksheet, curInp As String, lastRow As Long, i As Long
Set sh = ActiveSheet
lastRow = sh.Range("A" & Rows.Count).End(xlUp).row
curInp = Me.ComboBox1.Value 'use here your combo name
For i = 2 To lastRow
If CStr(sh.Range("E" & i).Value) = CStr(curInp) Then
If sh.Range("B" & i).Value = "Yes" Then
sh.Range("B" & i).Value = "No"
Else
MsgBox "Strange situation in row """ & i & """."
End If
End If
Next i
End Sub
Not tested, written on a tablet without Excel installed, but it should work...
I have working code that checks for a criteria in each row, and if met, copies that whole row of data over to a different workbook. But! I need to be able to add text to the last column of the copied data (Column S) that essentially labels what criteria was met that made the code copy it over because I will soon be expanding to check for multiple different criteria.
So for every row that meets the criteria and gets copied, I want to add "Criteria1" next to it in column S in the new workbook (it will always be column S that will be the first available column).
I have mangled this code together through inheritance and all of your help, so I don't really even know where to begin.
Private Sub Workbook_AfterSave(ByVal Success As Boolean)
Dim CoderBook As Workbook
Dim Referrals As Worksheet
Dim Review As Workbook
Dim Crit As Worksheet
Dim LastRow As Long
Dim NextRow As Long
Dim i As Long
Set CoderBook = Workbooks.Open("Coder Referrals.xlsx")
Set Referrals = CoderBook.Sheets("Sheet1")
Set Review = ThisWorkbook
Set Crit = Review.Sheets("Criteria")
'Search code
LastRow = Crit.Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Application.ScreenUpdating = False
'Loop search code
For i = 2 To LastRow
'Specialized Criteria1 Check
If Crit.Range("F" & i) <> Crit.Range("G" & i) Or _
Crit.Range("I" & i) <> Crit.Range("J" & i) Then
'If meets Criteria1 check, then copy appropriate rows to CoderBook Referrals sheet
Referrals.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).EntireRow.Value = Crit.Rows(i).Value
End If
Next i
'End loop code
CoderBook.Close SaveChanges:=True
Application.ScreenUpdating = True
End Sub
Split the or into two statements:
For i = 2 To LastRow
j = Referrals.Cells(Rows.Count, 1).End(xlUp).row + 1
'Specialized Criteria1 Check
If Crit.Range("F" & i) <> Crit.Range("G" & i) Then
'If meets Criteria1 check, then copy appropriate rows to CoderBook Referrals sheet
Referrals.Rows(j).EntireRow.Value = Crit.Rows(i).Value
Referrals.Range("S" & j).Value = "Criteria1"
End If
If Crit.Range("I" & i) <> Crit.Range("J" & i) Then
Referrals.Rows(j).EntireRow.Value = Crit.Rows(i).Value
if Referrals.Range("S" & j).value = vbNullString then
Referrals.Range("S" & j).Value = "Criteria2"
Else
Referrals.Range("S" & j).Value = Referrals.Range("S" & j).Value & ", " & "Criteria2"
End if
Next i
I'm very new to VBA so not sure where to start with this one. I have two separate workbooks saved in the same file location (Workbook 1 and Workbook 2)
what i'm looking for is When column C is populated in workbook 1, I want a macro that searches for that number in workbook 2 (column A).
If a match is found then I want the corresponding values from column C, D, E and G in Workbook 2 to be copied onto workbook 1.
Here is the values populated in Workbook1, then matched in Workbook2Here is the expected results, with the matched values populating Workbook1
Workbook 2 won't be opened by the user, they will just click a button in Workbook1 and it will populate the data.
I currently have this working but with Vlookups which has greatly slowed down opening workbook 1.
any help is appreciated.
Put this into the Code of the Sheet you are using in File1 and edit the Sheetnames and the Path. You dont need to press a button or anything, the macro will activate if the data in Column C changes and load the data of File2 into File1.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
Dim Sheet1, Sheet2 As Worksheet
Dim CellChanged As Integer
Dim Path, File As String
Dim LastRow As Long
Path = "C:\Users\User\Desktop\2.xlsx" 'Edit Path File2
File = Right$(Path, Len(Path) - InStrRev(Path, "\"))
Set Sheet1 = ThisWorkbook.Worksheets("Tabelle1") 'Edit Sheet File1
Set KeyCells = Range("C:C")
If Not Application.Intersect(KeyCells, Range(Target.Address)) _
Is Nothing Then
CellChanged = Target.Row
Workbooks.Open (Path)
Set Sheet2 = Workbooks(File).Worksheets("Tabelle1") 'Edit Sheet of File2
LastRow = Sheet2.Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To LastRow
If Sheet1.Range("C" & CellChanged).Value = Sheet2.Range("A" & i) Then
Sheet1.Range("D" & CellChanged).Value = Sheet2.Range("B" & i).Value 'Date
Sheet1.Range("E" & CellChanged).Value = Sheet2.Range("C" & i).Value 'Amount
Sheet1.Range("F" & CellChanged).Value = Sheet2.Range("F" & i).Value 'Payee
Sheet1.Range("G" & CellChanged).Value = Sheet2.Range("D" & i).Value 'Pol Number
Exit For
End If
Next i
Workbooks(File).Close savechanges:=False
End If
End Sub
EDIT:
Macro to start with a button with multiple edits (last cell change store in H1). Also added an Error handle.
Sub WithButton()
Dim KeyCells As Range
Dim Sheet1, Sheet2 As Worksheet
Dim CellChanged As Integer
Dim Path, File As String
Dim LastRow, LastData As Long
Dim Found As Boolean
On Error GoTo Handle
Set Sheet1 = ThisWorkbook.Worksheets("Tabelle1") 'Edit Sheet File1
If Sheet1.Range("H1").Value = "" Then
Sheet1.Range("H1").Value = 0
CellChanged = Sheet1.Cells(Rows.Count, "C").End(xlUp).Row
End If
If Sheet1.Cells(Rows.Count, "C").End(xlUp).Row > Sheet1.Range("H1").Value Then
Path = "C:\Users\L4R21D\Desktop\2.xlsx" 'Edit Path File2
File = Right$(Path, Len(Path) - InStrRev(Path, "\"))
CellChanged = Sheet1.Range("H1").Value + 1
Workbooks.Open(Path)
Set Sheet2 = Workbooks(File).Worksheets("Tabelle1") 'Edit Sheet of File2
LastRow = Sheet2.Cells(Rows.Count, "A").End(xlUp).Row
LastData = Sheet1.Cells(Rows.Count, "C").End(xlUp).Row
For i = 1 To LastRow
If Sheet1.Range("C" & CellChanged).Value = Sheet2.Range("A" & i) Then
Sheet1.Range("D" & CellChanged).Value = Sheet2.Range("B" & i).Value
Sheet1.Range("E" & CellChanged).Value = Sheet2.Range("C" & i).Value
Sheet1.Range("F" & CellChanged).Value = Sheet2.Range("F" & i).Value
Sheet1.Range("G" & CellChanged).Value = Sheet2.Range("D" & i).Value
Found = True
End If
If Found = True Or i = LastRow Then
If CellChanged = LastData Then
Exit For
End If
If Found = True Then
Found = False
CellChanged = CellChanged + 1
End If
i = 0
End If
Next i
Workbooks(File).Close savechanges:=False
Sheet1.Range("H1").Value = CellChanged
End If
Exit Sub
Handle:
MsgBox("Error")
End Sub
The button driven answer is amazing and both of your answers were godsends! I have written one program in python and this is my first foray into VB, and your support helped immensely! One thing that I think could be improved on with the button driven answer, is that if there is something in column C on sheet 1 that is not a match the program failed; I added a line to iterate CellChanged + 1 if there was not a match on Sheet 1:
If Found = True Then
Found = False
CellChanged = CellChanged + 1
**Else
CellChanged = CellChanged + 1**
End If
In my excel sheet I have the following code:
=IF(ISERROR(MATCH(D2,'Sheet 2'!A:A,0)),"",NOW())
This basically checks to see if the value in D2 matches any values in column A:A in sheet 2, and then populates the cell with a date and time with NOW().
My problem is the date and time is counting up because I am using the NOW() function whereas what I need is the date to, in a way, take a snapshot of the date or freeze the date. This table I am creating is acting like a log so I need the date to stay as it is when it is put into the cell.
Any help with this is much appreciated.
You could have this automatically run, if you paste it in the code behind your sheet (Where the range theCells is the column where the timestamps are going):
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
' The variable KeyCells contains the cells that will
' cause an alert when they are changed.
Set KeyCells = Range("theCells")
If Not Application.Intersect(KeyCells, Range(Target.Address)) _
Is Nothing Then
If Range(Target.Address).Value <> "" Then
Range(Target.Address).Copy
Range(Target.Address).PasteSpecial xlPasteVaues
End If
End Sub
Ok so I solved it, In my VBA I have the following code which pretty much creates a log file when my button is clicked, it takes various information in different cells and populates it in the next defined available row:
Sub copylog()
Dim LastRow As Long, ws As Worksheet
Dim wt As Worksheet
Set ws = Sheets("Create Log")
Set wt = Sheets("PDF Creation")
LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row + 1
ws.Range("A" & LastRow).Value = wt.Range("N11").Value
ws.Range("B" & LastRow).Value = wt.Range("N12").Value
ws.Range("C" & LastRow).Value = wt.Range("N13").Value
ws.Range("D" & LastRow).Value = wt.Range("N14").Value
ws.Range("E" & LastRow).Value = wt.Range("N15").Value
ws.Range("F" & LastRow).Value = wt.Range("N16").Value
ws.Range("G" & LastRow).Value = wt.Range("AT19").Value
ws.Range("H" & LastRow).Value = wt.Range("AT21").Value
ws.Range("I" & LastRow).Value = wt.Range("AT23").Value
ws.Range("J" & LastRow).Value = wt.Range("AT25").Value
ws.Range("K" & LastRow).Value = wt.Range("AT27").Value
ws.Range("L" & LastRow).Value = wt.Range("A2").Value
ws.Range("M" & LastRow).Value = Environ("Username")
End Sub
The code above will populate a table in the next available row, for example, the first line:
ws.Range("A" & LastRow).Value = wt.Range("N11").Value
This will take the value that populates N11 in the PDF create sheet and populate the next available row in column A in the create log sheet (using copy and paste).
The line that has fixed my time problem is the line:
ws.Range("L" & LastRow).Value = wt.Range("A2").Value
In cell A2, I have the NOW() function and the button copies and pastes it into the next available space in column L (copies and pastes as TEXT).