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...
Related
Cannot figure out how to get VBA to open a link.
I have an if formula In CN2 which will result in 1 of 5 URLs, the cell is clickable and will direct me to one of these URLS.
I thought perhaps VBA code does not like a formula based URL and turns the result into a hyperlink in CO2, but still I could not get it.
my error with the below code is "cannot open the specified file type"
Can anyone please assist?
Sub OpenURLs()
Dim i As Integer
For i = 1 To ActiveSheet.Range("Co2" & Rows.Count).End(xlUp).Row
Dim url As String
url = ActiveSheet.Range("Co2" & i).Value
ActiveWorkbook.FollowHyperlink url ' error here
' Copy the adjacent value in column CM
Dim valueToCopy As String
valueToCopy = ActiveSheet.Range("CM" & i).Value
ActiveSheet.Range("CM" & i).Copy
MsgBox "Click OK to continue to the next URL", vbOKOnly
Next i
End Sub
The bellow code only works IF the cell contains a hyperlink:
Sub OpenUrls()
Dim i As Long
Dim sh As Worksheet
Set sh = ActiveSheet
With sh
For i = 1 To .Range("A" & Rows.Count).End(xlUp).Row
Dim valueToCopy As String
If .Range("A" & i).Hyperlinks.Count > 0 Then
.Range("A" & i).Hyperlinks(1).Follow NewWindow:=False, AddHistory:=False
valueToCopy = .Range("B" & i).Value 'Not being used, decided to leave it
.Range("B" & i).Copy
MsgBox "Click OK to continue to the next URL", vbOKOnly
Application.CutCopyMode = False
End If
Next i
End With
End Sub
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
error im getting this error when using your code
Dim answer As Integer
answer = MsgBox("Äðóêóâàòè?", vbYesNo + vbQuestion, "Äðóê")
If answer = vbYes Then
ActiveSheet.PageSetup.PrintArea = "A1:N27"
ActiveWindow.SelectedSheets.PrintOut
Else
'End
End If
End Sub
need the macro to print areas that are field within range A1:N27 and delete blank can someone solve it?
Due to my fault there where three problems that FaneDuru has found with my workbook that his code didn't worked with my workbook
The rows to be hide/deleted are not empty. They contains formulas...
The result of formula on column D:D is "".
The worksheet in discussion is protected, but without a password
Try the next code, please. It will hide the rows being empty on the range B:L, print and then un-hide them. The updated code is done according to your last specifications (there are formulas in the 'empty' rows, in column D:D the formula result is "" and the worksheet is protected, but without a password):
Sub testRemoveRowsPrintAreaSet()
Dim sh As Worksheet, lastRow As Long, rngDel As Range, i As Long
Set sh = ActiveSheet
lastRow = sh.Range("C" & Rows.Count).End(xlUp).Row
For i = 9 To lastRow
Debug.Print WorksheetFunction.CountBlank(sh.Range("B" & i & ":L" & i))
If WorksheetFunction.CountBlank(sh.Range("B" & i & ":L" & i)) = 10 Then
If rngDel Is Nothing Then
Set rngDel = sh.Range("M" & i)
Else
Set rngDel = Union(rngDel, sh.Range("M" & i))
End If
End If
Next i
If Not rngDel Is Nothing Then
sh.Unprotect
rngDel.EntireRow.Hidden = True
End If
sh.PageSetup.PrintArea = "A1:N" & lastRow
ActiveWindow.SelectedSheets.PrintOut
rngDel.EntireRow.Hidden = False
sh.Protect
End Sub
Please, confirm that it work as you need.
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
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