I did it thank you very much.
Posts by mythu


I understand but if it can be done even later. I would apreciate it. Otherwise no problem and thank you for being so nice

Thank you. Its opening the Calendar now but not writing the Dates. I would appreciate if you could resolve this too.

I want to call this calender in column A by pressing double click but do not know how to call. I would really appreciate you help thanks.

Thank you very much you corrected the mistake.

I have been trying to match the values with vlookup and after that summed up.
My formula is working well but an error is appear in last highlighted cells .
Any help will be appreciated

I have been using these two codes CellVal and Private Sub Worksheet_Change(ByVal Target As Range)
When i run the code CellVal that updates the next ID in the Sheets("Sheet1").Range("B6") if B6 is empty then it loads the first ID and set a trigger on cell B6 for second code, that whenever that cell is update second code is run.
Explaining second code
when 1st ID is load in Cell B6 then second code runs and copy the Sheet2.Range(B4) and Paste into Sheet3.Range(B4)
When 2nd ID is load in Cell B6 then second code runs and copy the Sheet2.Range(B4) and Paste into Sheet3.Range(C4)
When 3rd ID is load in Cell B6 then second code runs and copy the Sheet2.Range(B4) and Paste into Sheet3.Range(D4)
same for 4th and 5th and 6th and 7th`and 8th
Now the problem is that i run the code 8th times to load the next ID in Sheets("Sheet1").Range("B6") I want a help that How to set a trigger for code CellVal in sheet3 that ID will update automatically. If it got resolved then i have to run the code one time to update all values one by one rather than running the code 8th times.
Any help will be appreciated.
Code Sub CellVal()
 If Sheet3.Range("B4") = 0 Then
 Sheet3.Range("B4") = ""
 End If
 Dim sht1 As Worksheet, lastR As Long, rng As Range
 Dim ECell As Range, cExist As Range, i As Long
 Application.ScreenUpdating = False
 Set sht1 = Sheets("Sheet1")
 Set ECell = sht1.Range("B6")
 lastR = sht1.Range("C" & sht1.Rows.Count).End(xlUp).Row
 Set rng = sht1.Range("C27:C" & lastR)
 If ECell.Value = "" Then
 ECell.Value = rng.SpecialCells(xlCellTypeConstants).Areas(1).Value
 Else
 Set cExist = rng.Find(What:=ECell.Value, After:=rng.Cells(1), _
 LookAt:=xlWhole, LookIn:=xlValues, SearchOrder:=xlByRows)
 If Not cExist Is Nothing Then
 For i = 1 To lastR  cExist.Row
 If cExist.Offset(i).Value <> "" Then
 ECell.Value = cExist.Offset(i).Value
 Exit For
 End If
 Next i
 End If
 End If
 Application.ScreenUpdating = True
 End Sub
 Private Sub Worksheet_Change(ByVal Target As Range)
 If Target.Address = "$B$6" Then
 Application.ScreenUpdating = False
 Dim sht2 As Worksheet
 Dim sht3 As Worksheet
 Dim col As Long
 Set sht2 = Sheets("Sheet2")
 Set sht3 = Sheets("Sheet3")
 col = sht3.Cells(4, sht3.Columns.Count).End(xlToLeft).Column + 1
 If col = 3 Then
 sht2.Cells(4, 17).copy
 Else
 sht2.Cells(4, 2).copy
 End If
 sht3.Cells(4, col).PasteSpecial xlPasteValues
 End If
 Application.ScreenUpdating = True
 End Sub

Thank you once again rory it is exactly what i have been looking for.

Thank you very much rory for sure Arrays are better. But second issue is still exists that if i run the Module1 code the result comes with error #VALUE! rather than output.
I.
Code Dim lastfor As Long
 Application.ScreenUpdating = False
 lastfor = Sheet2.Cells(Rows.Count, 148).End(xlUp).Row
 Sheet2.Range("ES3").Formula2 = _
 "=ConcatStringConditional(R2C140:R10000C140,RC[1],R2C142:R10000C142)"
 Sheet2.Range("ES3").AutoFill Destination:=Sheet2.Range("ES3:ES" & lastfor), Type:=xlFillDefault
 Sheet2.Range("ET3").Formula2 = _
 "=ConcatStringConditional(R2C140:R10000C140,RC[2],R2C141:R10000C141)"
 Sheet2.Range("ET3").AutoFill Destination:=Sheet2.Range("ET3:ET" & lastfor), Type:=xlFillDefault
 Application.ScreenUpdating = True

I have a problem, hopefully someone may be able to help. I have been using MS Office 2016 wherein TEXTJOIN function does not work so i have added EXCEL UDF Function to make it work like TEXTJOIN works.
Here is the formula
I have pasted this formula through VBA but it returns with an error that is #VALUE! I have attached a file below wherein UDF and VBA formula both codes are available.
The code is extremely slow and is it possible to convert this below range into used range like we mostly used lastfor = Sheet2.Cells(Rows.Count, 148).End(xlUp).Row might speed could be better this way if i am not wrong.
I will really appreciate the help.

Thank you very much Carim i will amend it according to my needs.

Just trying to accomplish that when i change the year (D6) or Month (D7) then dates should be populated accordingly in the cells through VBA.

I have been working on a task where i would have to create a dynamic calendar through VBA. I know you are guiding well way to accomplish the thing via Formula. But i have to follow the task to make it through VBA.

I have been trying to create a calendar through Excel VBA. Right now the Calendar is working via formula available in the cells.
My code is working for just three rows whereas 2 are remaining and code is pasting formula which i will convert in values later when it gets completed.
I have found but all are created by formulas not through VBA if you have some examples then please share or if you can provide solution. Your help will be appreciated.

I have tried to make this Calendar Dynamic through Excel VBA where i have recorded macros one by one which took mine too much time.
I hope there would be an easy way to make Calendar Dynamic through VBA.
Any help will be appreciated.
Here is my recorded Macros.
Code Sheet9.Range("C12").FormulaR1C1 = _
 "=Pivot!R138C126WEEKDAY(Pivot!R138C126,1)+(ROW(RC)ROW(R12C3))*7+(COLUMN(RC)COLUMN(R12C3)+1)"
 Sheet9.Range("D12").FormulaR1C1 = _
 "=Pivot!R138C126WEEKDAY(Pivot!R138C126,1)+(ROW(RC)ROW(R12C3))*7+(COLUMN(RC)COLUMN(R12C3)+1)"
 Sheet9.Range("E12").FormulaR1C1 = _
 "=Pivot!R138C126WEEKDAY(Pivot!R138C126,1)+(ROW(RC)ROW(R12C3))*7+(COLUMN(RC)COLUMN(R12C3)+1)"
 Sheet9.Range("F12").FormulaR1C1 = _
 "=Pivot!R138C126WEEKDAY(Pivot!R138C126,1)+(ROW(RC)ROW(R12C3))*7+(COLUMN(RC)COLUMN(R12C3)+1)"
 Sheet9.Range("G12").FormulaR1C1 = _
 "=Pivot!R138C126WEEKDAY(Pivot!R138C126,1)+(ROW(RC)ROW(R12C3))*7+(COLUMN(RC)COLUMN(R12C3)+1)"
 Sheet9.Range("H12").FormulaR1C1 = _
 "=Pivot!R138C126WEEKDAY(Pivot!R138C126,1)+(ROW(RC)ROW(R12C3))*7+(COLUMN(RC)COLUMN(R12C3)+1)"
 Sheet9.Range("I12").FormulaR1C1 = _
 "=Pivot!R138C126WEEKDAY(Pivot!R138C126,1)+(ROW(RC)ROW(R12C3))*7+(COLUMN(RC)COLUMN(R12C3)+1)"
 Sheet9.Range("C17").FormulaR1C1 = _
 "=Pivot!R138C126WEEKDAY(Pivot!R138C126,1)+(ROW(R[5]C[7])ROW(R12C3))*7+(COLUMN(R[5]C[7])COLUMN(R12C3)+1)"
 Sheet9.Range("D17").FormulaR1C1 = _
 "=Pivot!R138C126WEEKDAY(Pivot!R138C126,1)+(ROW(R[5]C[7])ROW(R12C3))*7+(COLUMN(R[5]C[7])COLUMN(R12C3)+1)"
 Sheet9.Range("E17").FormulaR1C1 = _
 "=Pivot!R138C126WEEKDAY(Pivot!R138C126,1)+(ROW(R[5]C[7])ROW(R12C3))*7+(COLUMN(R[5]C[7])COLUMN(R12C3)+1)"
 Sheet9.Range("F17").FormulaR1C1 = _
 "=Pivot!R138C126WEEKDAY(Pivot!R138C126,1)+(ROW(R[5]C[7])ROW(R12C3))*7+(COLUMN(R[5]C[7])COLUMN(R12C3)+1)"
 Sheet9.Range("G17").FormulaR1C1 = _
 "=Pivot!R138C126WEEKDAY(Pivot!R138C126,1)+(ROW(R[5]C[7])ROW(R12C3))*7+(COLUMN(R[5]C[7])COLUMN(R12C3)+1)"
 Sheet9.Range("H17").FormulaR1C1 = _
 "=Pivot!R138C126WEEKDAY(Pivot!R138C126,1)+(ROW(R[5]C[7])ROW(R12C3))*7+(COLUMN(R[5]C[7])COLUMN(R12C3)+1)"
 Sheet9.Range("I17").FormulaR1C1 = _
 "=Pivot!R138C126WEEKDAY(Pivot!R138C126,1)+(ROW(R[5]C[7])ROW(R12C3))*7+(COLUMN(R[5]C[7])COLUMN(R12C3)+1)"
 Sheet9.Range("C22").FormulaR1C1 = _
 "=Pivot!R138C126WEEKDAY(Pivot!R138C126,1)+(ROW(R[10]C[14])ROW(R12C3))*7+(COLUMN(R[10]C[14])COLUMN(R12C3)+1)"
 Sheet9.Range("D22").FormulaR1C1 = _
 "=Pivot!R138C126WEEKDAY(Pivot!R138C126,1)+(ROW(R[10]C[14])ROW(R12C3))*7+(COLUMN(R[10]C[14])COLUMN(R12C3)+1)"
 Sheet9.Range("E22").FormulaR1C1 = _
 "=Pivot!R138C126WEEKDAY(Pivot!R138C126,1)+(ROW(R[10]C[14])ROW(R12C3))*7+(COLUMN(R[10]C[14])COLUMN(R12C3)+1)"
 Sheet9.Range("F22").FormulaR1C1 = _
 "=Pivot!R138C126WEEKDAY(Pivot!R138C126,1)+(ROW(R[10]C[14])ROW(R12C3))*7+(COLUMN(R[10]C[14])COLUMN(R12C3)+1)"
 Sheet9.Range("G22").FormulaR1C1 = _
 "=Pivot!R138C126WEEKDAY(Pivot!R138C126,1)+(ROW(R[10]C[14])ROW(R12C3))*7+(COLUMN(R[10]C[14])COLUMN(R12C3)+1)"
 Sheet9.Range("H22").FormulaR1C1 = _
 "=Pivot!R138C126WEEKDAY(Pivot!R138C126,1)+(ROW(R[10]C[14])ROW(R12C3))*7+(COLUMN(R[10]C[14])COLUMN(R12C3)+1)"
 Sheet9.Range("I22").FormulaR1C1 = _
 "=Pivot!R138C126WEEKDAY(Pivot!R138C126,1)+(ROW(R[10]C[14])ROW(R12C3))*7+(COLUMN(R[10]C[14])COLUMN(R12C3)+1)"

Resolved it that was my mistake thank you.

Hi, Carim why the SUM is not equal i have highlighted the SUM with Orange color.
Please look into this problem.

Thank you very much for the clarification.

thank you very much for the shorter solution.
But if you test the below attached sheet to filter the data with your code. Why filter is start from Row8 rather than Row11.

I have wrote a code to filter the data with multiple strings but its not working. I have attached a workbook as well your help will be appreciated.
Code Sub Filter_My_Data()
 Dim Data_sh As Worksheet
 Dim Filter_Criteria_Sh As Worksheet
 Dim Output_sh As Worksheet
 Set Data_sh = ThisWorkbook.Sheets("Data")
 Set Filter_Criteria_Sh = ThisWorkbook.Sheets("Filter_Criteria")
 Dim Emp_list() As String
 Dim n As Integer
 n = Application.WorksheetFunction.CountA(Filter_Criteria_Sh.Range("A:A"))
 ReDim Emp_list(n) As String
 Dim i As Integer
 For i = 0 To n
 Emp_list(i) = Filter_Criteria_Sh.Range("A20" & i + 2)
 Next i
 Data_sh.Range("B11").AutoFilter 2, Emp_list(), xlFilterValues
 End Sub