Posts by xchorok

xchorok · Jan 30th 2020

HI all,

I've been looking all previous threads to find my answer, however most of the macros are for Outlook (I need one for Excel).

Is there Excel Macro to 'Reply to the currently opened email'?

Code

Sub demo()
Dim objOutlook As Object
Set objOutlook = CreateObject("Outlook.Application")
Dim objEmail As Object
Set objEmail = objOutlook.CreateItem(olMailItem)
With objEmail.Reply
.SentOnBehalfOfName = "[email protected]"
.To = "[email protected]"
.Subject = "Reminder Mail"
.Body = "demo mail."
'.Attachments.Add ("C:\test.txt")
.Display
End With
Set objEmail = Nothing
Set objOutlook = Nothing
End Sub

Display More

xchorok · Jan 22nd 2020

Hi team,

I've create a long macro to filter by Date and return the number of visible rows - however this is not working somehow.

Also, I want my code to be shorter if possible.

Could you please help me to generate a better code?

I have attached 2 files - One to run the macro and one for Sample Data Book.

Code

Sub TESTMacro()
On Error Resume Next
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
Dim wkbCrntWorkBook As Workbook
Dim wkbSourceBook As Workbook
Dim rngSourceRange As Range
Dim rngDestination As Range
Set wkbCrntWorkBook = Workbooks("Book1.xlsm")
With Application.FileDialog(msoFileDialogOpen)
.Filters.Clear
.Filters.Add "All Excel Files", "*.xl*"
.Filters.Add "All Files", "*.*"
.AllowMultiSelect = False
.Show
If .SelectedItems.count > 0 Then
Workbooks.Open .SelectedItems(1)
Set wkbSourceBook = ActiveWorkbook
Set rngSourceRange = ActiveSheet.Cells
'--------------------------------------------------------------------
' THURSDAY
'------------------------------------------------------------------
' 1. COLOR
'------------------------------------------------------------------
'Filter by Date
Dim dDate As Date
Dim strDate As String
Dim lDate As Long
wkbSourceBook.Sheets("COLOR").Range("G2").Value = wkbCrntWorkBook.Sheets("Macro").Range("D2").Value
dDate = Range("G2")
lDate = dDate
Range("A1").AutoFilter Field:=3, Criteria1:=">" & lDate
'Count Visible Rows
Dim rng As Range
Set rng = ActiveSheet.AutoFilter.Range
wkbCrntWorkBook.Sheets("Macro").Range("E4").Value = rng.Columns(1).SpecialCells(xlCellTypeVisible).count - 1
'------------------------------------------------------------------
' 2. ANIMAL
'------------------------------------------------------------------
'Filter by Date
wkbSourceBook.Sheets("ANIMAL").Range("G2").Value = wkbCrntWorkBook.Sheets("Macro").Range("D2").Value
dDate = Range("G2")
lDate = dDate
Range("A1").AutoFilter Field:=3, Criteria1:=">" & lDate
'Count Visible Rows
wkbCrntWorkBook.Sheets("Macro").Range("E6").Value = rng.Columns(1).SpecialCells(xlCellTypeVisible).count - 1
'------------------------------------------------------------------
' 3. NUMBER
'------------------------------------------------------------------
'Filter by Date
wkbSourceBook.Sheets("NUMBER").Range("G2").Value = wkbCrntWorkBook.Sheets("Macro").Range("E2").Value
dDate = Range("G2")
lDate = dDate
Range("A1").AutoFilter Field:=5, Criteria1:=">" & lDate
'Count Visible Rows
wkbCrntWorkBook.Sheets("Macro").Range("E12").Value = rng.Columns(1).SpecialCells(xlCellTypeVisible).count - 1
'------------------------------------------------------------------
' 4. TABLE
'------------------------------------------------------------------
'Filter by Date
wkbSourceBook.Sheets("TABLE").Range("G2").Value = wkbCrntWorkBook.Sheets("Macro").Range("E2").Value
dDate = Range("G2")
lDate = dDate
Range("A1").AutoFilter Field:=5, Criteria1:=">" & lDate
'Count Visible Rows
wkbCrntWorkBook.Sheets("Macro").Range("E14").Value = rng.Columns(1).SpecialCells(xlCellTypeVisible).count - 1
'------------------------------------------------------------------
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True
End If
End With
End Sub

Display More

Thank you!

xchorok · Jan 12th 2020

Hi Carim

Apologies for a late response but - the Test file you've attached is a file what I exactly needed!

Thank you so much for your help!

xchorok · Jan 10th 2020

Hi team,

I am unsure if my problem can be solved using Excel VBA, however I will give it a try.

I have a really long formula as below.

My ultimate goal is to make this formula short.

The formula is written to write Yes if Last 3 digit numbers of Table Number and the Team color is matching.

(For example, as per the table in Data Tab, Team Color must be Blue if last 3 digit numbers of Table Number is 135. Team Color must be Green if last 3 digit numbers of Table Number is 118.)

Can any VBA Master help me to achieve below:

I want to use the table in Data Tab, instead of keep making the formula long and big.
I want to apply this formula whenever I update the table in Data Tab (I can add/delete/update numbers and Team Colors in future.)

Below is my current code, and I am attaching the file for your attention.

Code

Sub Formula()
'Formula
Dim LastRowColumnB As Long
Dim BlueVar As Variant
LastRowColumnB = Cells(Rows.Count, 2).End(xlUp).Row
Sheets("Table").Range("C2:C" & LastRowColumnB).Formula = _
"=IF(OR(AND(C[-2]=""Blue"",OR(ISNUMBER(SEARCH(""135"",C[-1])),ISNUMBER(SEARCH(""136"",C[-1])),ISNUMBER(SEARCH(""137"",C[-1])),ISNUMBER(SEARCH(""138"",C[-1])),ISNUMBER(SEARCH(""139"",C[-1])),ISNUMBER(SEARCH(""140"",C[-1]))))," & _
"AND(C[-2]=""Purple"",ISNUMBER(SEARCH(""439"",C[-1])))," & _
"AND(C[-2]=""Yellow"",ISNUMBER(SEARCH(""412"",C[-1])))," & _
"AND(C[-2]=""Green"",ISNUMBER(SEARCH(""118"",C[-1])))," & _
"AND(C[-2]=""Red"",ISNUMBER(SEARCH(""090"",C[-1]))))," & _
"""Yes"",""No"")" & _
""
' message Box
MsgBox "Completed!"
End Sub

Display More

Thanks!

xchorok · Dec 18th 2019

This is perfect!

Thank you Carim! Love your work and thanks for help!

xchorok · Dec 17th 2019

Thank you Carim!

I tested it, and I noticed there are 2 things I want to discuss with you:

1. When I tried, it did not allow me to update the blank cells - instead, it replaces all.

(For example, when I want to just update Phone Number and Mobile Number for Ellen, it removes all previous information and only adds Phone Number and Mobile Number.)

I will just remove my request to replace cells with new data in "Template" sheet, but want to change to 'update blank cells only'.

Can you please help me to generate macro code to update blank cells only?

2. I want to change the Macro to compare First Name and Last Name in "Template" sheet with the First Name and Last Name in "Contact Details" sheet.

I am attaching my previous data and code again for your help.

Thank you!

Code

Sub Test2()
Dim lookUpSheet As Worksheet, updateSheet As Worksheet
Dim valueToSearch As String
Dim i As Integer, j As Integer, t As Integer
Dim lastRowLookup As Long, lastColumnUpdate As Long
Dim found As Range
Set lookUpSheet = Sheets("Template")
Set updateSheet = Sheets("Contact Details")
'get the number of the last row with data in Contact Details
lastRowLookup = updateSheet.Cells(Rows.Count, "B").End(xlUp).Row + 1
'get the number of the last column with data in Template
lastColumnUpdate = lookUpSheet.Cells(1, Columns.Count).End(xlToLeft).Column
'for First name Template
' Loop All Columns in Sheet2 Template
For j = 2 To lastColumnUpdate
valueToSearch = lookUpSheet.Cells(2, j) And lookUpSheet.Cells(3, j)
'look the value in Column B of Contact Details
Set found = updateSheet.Columns("B:B").Find(What:=valueToSearch, After:=updateSheet.Range("B1:B2"), LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If found Is Nothing Then
' Not Found
updateSheet.Range("A" & lastRowLookup & ":K" & lastRowLookup).Value = WorksheetFunction.Transpose(Range(lookUpSheet.Cells(1, j), lookUpSheet.Cells(11, j)))
Else
' Found
i = found.Row
updateSheet.Range("A" & i & ":K" & i).Value = WorksheetFunction.Transpose(Range(lookUpSheet.Cells(1, j), lookUpSheet.Cells(11, j)))
End If
Next j
End Sub

Display More

xchorok · Dec 17th 2019

Hi team,

I've looked up all previous threads to find similar code, however could not find one.

I want to compare First Name in "Template" sheet with the First Name in "Contact Details" sheet.

If there is matching one, I wan to update any blank cells (or replace with new data in "Template" sheet) in "Contact Details" Sheet.

If there is no match, I want to add another row in "Contact Details" sheet.

Below is what I have tried, and I am attaching the spreadsheet as well.

Thank you!

Code

Sub test1()
Dim lookUpSheet As Worksheet, updateSheet As Worksheet
Dim valueToSearch As String
Dim i As Integer, t As Integer
Set lookUpSheet = Worksheets("Template")
Set updateSheet = Worksheets("Contact Details")
'get the number of the last row with data in Contact Details
lastRowLookup = lookUpSheet.Range("B2:B11")
'get the number of the last column with data in Template
lastColumnUpdate = updateSheet.Cells(1, Columns.Count).End(xlToLeft).Column
'for First name Template
For i = 1 To lastColumnUpdate
valueToSearch = updateSheet.Cells(2, 2)
'look the value in column A of Contact Details
For t = 1 To lastRowLookup
'if found a match, copy column B value to Contact Details and proceed to the next value
If lookUpSheet.Cells(t, 2) = valueToSearch Then
updateSheet.Cells(2, i) = lookUpSheet.Cells(t, 2)
Else
last2 = lookUpSheet.Cells(Rows.Count, 2).End(xlUp).Row + 1
Exit For
End If
Next t
Next i
End Sub

Display More

xchorok · Dec 12th 2019

I just lost my word. This is PERFECT!! Thank you so much Carim! Like Like Like!

xchorok · Dec 12th 2019

Hi team,

I would like your help to create macro to create hyperlink between worksheets.

I tried below, however it is not working.

Would anyone please help?

I tried Vloopup and Hyperlink but it does not work as well (=HYPERLINK(VLOOKUP(A7,Instructions!A:A,1,FALSE),"LINK"))

Code

Sub UpdateInstruction()
Dim LRowI As Integer
Dim LRowC As Integer
Dim LContinue As Boolean
'Clear all hyperlinks from the active sheet
ActiveSheet.Hyperlinks.Delete
LRowE = 1
While Len(Range("A" & CStr(LRowI)).Value) > 0
LRowC = 1
LContinue = True
If Worksheets("Instructions").Range("A" & CStr(LRowI)).Text = Worksheets("Checklist").Range("A" & CStr(LRowC)).Text Then
Range("A" & CStr(LRowI)).Select
Worksheets("Instructions").Hyperlinks.Add Anchor:=Selection, _
Address:="", _
SubAddress:="A" & CStr(LRowC), _
ScreenTip:="A" & CStr(LRowC)
LContinue = False
End If
LRowC = LRowC + 1
If Len(Range("B" & CStr(LRowC)).Value) = 0 Then
LContinue = False
End If
Wend
LRowE = LRowE + 1
End Sub

Display More

Thank you!

xchorok · Dec 12th 2019

This is Perfect!

Thank you so much!!!!!

xchorok · Dec 11th 2019

I've tried below as well..

Code

Sub VBAIntersect2()
Dim aRng As Range
Dim bRng As Range
Set aRng = Worksheets("Macro").Range("B3:B15")
Set bRng = Worksheets("Macro").Range("D2")
For Each aCell In aRng
For Each BCell In bRng
Worksheets("Register").Intersect(Range("aCell.Text"), Range("BCell.Text")).Value = Worksheets("Macro").Range("C1").Value
Next BCell
Next aCell
End Sub

Display More

xchorok · Dec 10th 2019

Below is something I tried to do:

Code

Sub search1()
Dim lastRow As Long, x As Long
lastRow = Worksheets("Macro").Cells(Rows.Count, 1).End(xlUp).Row
If Worksheets("Macro").Range("B4:B15").Value = Worksheets("Register").Columns("B:B").Value And
Worksheets("Macro").Range("C2").Value = Worksheets("Register").Rows("1:1").Value Then
Worksheets("Macro").Range("C1").Value = Worksheets("Register").Cells(x, 3).Value
End If
Next x
End Sub

Display More

xchorok · Dec 10th 2019

Thank you Carim,

Please find attached.

xchorok · Dec 10th 2019

Hi all,

I need your help to create macro:

"Sheet1" has data below:

Tag	CHECK
Check No	Number 3
Countries
Slovakia
Poland
Germany
France
United Kingdom
Indonesia

"Sheet2" has below data:

Check No	Number 1	Number 2	Number 3	Number 4	Number 5
Countries
Bulgaria
Cyprus
Finland
France
Germany
Hungary
Italy
Luxembourg
Netherlands
Poland
Portugal
Romania
Slovakia
Spain
United Kingdom

I want to add Tag (in this case, "CHECK") to matching intersection cells in Sheet2.

If there is no data in Sheet2, then I wan to add another Row at the end of the data. (In this case, Indonesia is not on Sheet2, I want to create new row for Indonesia).

The desired outcome:

Check No	Number 1	Number 2	Number 3	Number 4	Number 5
Countries
Bulgaria
Cyprus
Finland
France			CHECK
Germany			CHECK
Hungary
Italy
Luxembourg
Netherlands
Poland			CHECK
Portugal
Romania
Slovakia			CHECK
Spain
United Kingdom			CHECK
Indonesia			CHECK

The Countries will be changed every week, and Tag can also be changed.

So, if I want to change the Tag to ALERT and I want to add this Tag to some countries (Italy, Poland, France and Spain) under Check Number 4;

The desired outcome:

Check No	Number 1	Number 2	Number 3	Number 4	Number 5
Countries
Bulgaria
Cyprus
Finland
France			CHECK	ALERT
Germany			CHECK
Hungary
Italy				ALERT
Luxembourg
Netherlands
Poland			CHECK	ALERT
Portugal
Romania
Slovakia			CHECK
Spain				ALERT
United Kingdom			CHECK
Indonesia			CHECK

Anyone can help me?

Thank you!

Posts by xchorok

Excel VBA - Reply to the opened email

Excel VBA - Filter by Date and return the number of visible rows

Excel VBA - Apply Complex Formula

Excel VBA - Apply Complex Formula

Excel VBA - Update Master sheet by comparing data in another sheet

Excel VBA - Update Master sheet by comparing data in another sheet

Excel VBA - Update Master sheet by comparing data in another sheet

Excel VBA - Create hyperlink to different sheet when the cell value is same

Excel VBA - Create hyperlink to different sheet when the cell value is same

Excel VBA - Update Cells in Different Worksheet using Row and Column Number

Excel VBA - Update Cells in Different Worksheet using Row and Column Number

Excel VBA - Update Cells in Different Worksheet using Row and Column Number

Excel VBA - Update Cells in Different Worksheet using Row and Column Number

Excel VBA - Update Cells in Different Worksheet using Row and Column Number