D14 =SUMPRODUCT((H6:BO6)*(H3:BO3=D13))
H6 = 0
Another one
D15=SUMIF(H3:BO3;D13;H7:BO7)
D14 =SUMPRODUCT((H6:BO6)*(H3:BO3=D13))
H6 = 0
Another one
D15=SUMIF(H3:BO3;D13;H7:BO7)
Next code could help
Option Explicit
Sub Macro1()
Dim K As String, O As String, T As String
Dim Ord As Integer
O = Range("b2"): K = Range("b3")
If O = "xlAscending" Then Ord = 1
If O = "xlDescending" Then Ord = 2
ActiveWorkbook.Worksheets("data").ListObjects("data").Sort.SortFields.Clear
T = "data[[#All],[" & K & "]]"
ActiveWorkbook.Worksheets("data").ListObjects("data").Sort.SortFields.Add2 _
Key:=Range(T), SortOn:=xlSortOnValues, _
Order:=Ord, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("data").ListObjects("data").Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
Display More
See next code and file attached.
Adjust sheet Email Template to your needs
Option Explicit
Sub AnniversaryEmail()
Dim Rg As Range
For Each Rg In Range([F3], Cells(Rows.Count, "F").End(3))
If (Rg.Value = Date) Then
Dim DestEmail As String
Dim CopyEmail As String
Dim WkRg As Range
Dim F
Dim EmailTopic As String
Dim EmailWhat As String
Dim EmailSubject As String
Dim EmailStart1 As String, EmailStart2 As String
Dim EmailEnd1 As String, EmailEnd2 As String
Dim EmailBody As String
Dim FullEmail As String
Dim myOlApp As Outlook.Application
Dim myItem As Outlook.MailItem
Set myOlApp = CreateObject("Outlook.Application")
Set myItem = myOlApp.CreateItem(olMailItem)
'--- Email info
EmailSubject = Range("EmailSubject")
EmailStart1 = Range("EmailStart1")
EmailStart2 = Range("EmailStart2")
EmailBody = Range("EmailBody")
EmailEnd1 = Range("EmailEnd1")
EmailEnd2 = Range("EmailEnd2")
FullEmail = EmailStart1 _
& Chr(10) & Chr(10) & _
EmailStart2 _
& Chr(10) & Chr(10) & _
EmailBody _
& Chr(10) & Chr(10) & _
EmailEnd1 _
& Chr(10) & Chr(10) & _
EmailEnd2 _
& Chr(10)
'--- People info
DestEmail = Rg.Offset(0, -2)
' CopyEmail = Range("CopyEmail")
'--- Send Email
Application.DisplayAlerts = False
With myItem
If (DestEmail <> "") Then
.To = DestEmail
.CC = CopyEmail
.Subject = EmailSubject
.Body = FullEmail
.Send
End If
End With
Application.DisplayAlerts = True
'--- Close
Set myItem = Nothing
Set myOlApp = Nothing
End If
Next
MsgBox " Job done", , "INFORMATION"
End Sub
Display More
meowsongg welcome on board,
To help you easely, will you please attach an Excel sample file showing how is you data layout and what is the expected result.
PCI
Open your own thread ....!
See next code
Option E
xplicit
Sub Treat()
Const WkCol = "C"
Const WkChar = "C"
Const DstWsN = "RAWS Closed Jobs"
Dim LR1 As Integer, LR2 As Integer, I As Integer
LR1 = Cells(Rows.Count, WkCol).End(3).Row
For I = LR1 To 2 Step -1
If (Cells(I, WkCol) = WkChar) Then
With Sheets(DstWsN)
LR2 = .Cells(Rows.Count, WkCol).End(3).Row
Cells(I, WkCol).EntireRow.Copy Destination:=.Cells(LR2 + 1, 1)
End With
Cells(I, WkCol).EntireRow.Delete Shift:=xlUp
End If
Next
End Sub
Display More
Option Explicit
Sub Treat()
Const WkCol = "C"
Const WkChar = "C"
Const DstWsN = "RAWS Closed Jobs"
Dim LR1 As Integer, LR2 As Integer, I As Integer
LR1 = Cells(Rows.Count, WkCol).End(3).Row
For I = LR1 To 2 Step -1
If (Cells(I, WkCol) = WkChar) Then
With Sheets(DstWsN)
LR2 = .Cells(Rows.Count, WkCol).End(3).Row
Cells(I, WkCol).EntireRow.Copy Destination:=.Cells(LR2 + 1, 1)
End With
Cells(I, WkCol).EntireRow.Delete Shift:=xlUp
End If
Next
End Sub
Display More
See next code
Option Explicit Sub Treat() Const WkCol = "C" Const WkChar = "C" Const DstWsN = "RAWS Closed Jobs" Dim LR1 As Integer, LR2 As Integer, I As Integer LR1 = Cells(Rows.Count, WkCol).End(3).Row For I = LR1 To 2 Step -1 If (Cells(I, WkCol) = WkChar) Then With Sheets(DstWsN) LR2 = .Cells(Rows.Count, WkCol).End(3).Row Cells(I, WkCol).EntireRow.Copy Destination:=.Cells(LR2 + 1, 1) End With Cells(I, WkCol).EntireRow.Delete Shift:=xlUp End If Next End Sub
Your second file with a macro to refresch the PT
Have ever seen for the use of a Pivot Table
See you file updated in attachment
Hi HeitorR,
Can you see to attach an Excel file to be sure to fit the code to your need and go faster
PCI
To avoid showing some point in a chart when there no data try to use #N/A
It means you should use a formula to check if there is data for July and then get #N/A as result
= IF(Counta(your range)= 0 ,#N/A,"July")
Clear, try next code
Option Explicit
Sub SplitData()
Const StartStg As String = "UTC NOTE"
Const EndStg As String = "ENDNOTE"
Const FR As Integer = 2
Dim WkStg As String
Dim LC As Integer, LR As Integer, I As Integer, J As Integer
Dim StNb As Integer, EndNb As Integer
Dim SFlg As Boolean
Dim T
Application.ScreenUpdating = False
LR = Cells(Rows.Count, 1).End(3).Row
LC = Cells(FR, Columns.Count).End(xlToLeft).Column
For I = FR + 1 To LR
SFlg = True
WkStg = Cells(I, 1)
J = 1
While SFlg
With Application
T = Not (.IsError(.Search(StartStg & "*" & EndStg, WkStg, J)))
If (T) Then
StNb = .Search(StartStg, WkStg, J + 1) + Len(StartStg) + 1
EndNb = .Search(EndStg, WkStg, J + 1)
Cells(I, LC + 1) = Mid(WkStg, StNb, EndNb - StNb)
J = EndNb
Else
SFlg = False
End If
End With
Wend
Next I
Application.ScreenUpdating = True
MsgBox (" Job Done")
End Sub
Display More
Just to start see the macro in the file attached: It prepares all strings which fit into your specifications (from UTC NOTE to ENDNOTE) and record these string after the last column.
After we could see to display only strings where exist a particular word
Of course it is a macro but it is to be sure the understanding is good and a result possible
Option Explicit
Sub SplitData()
Const StartStg As String = "UTC NOTE"
Const EndStg As String = "ENDNOTE"
Dim WkStg As String
Dim LC As Integer, LR As Integer, I As Integer, J As Integer
Dim StNb As Integer, EndNb As Integer
Dim SFlg As Boolean
Dim T
LR = Cells(Rows.Count, 1).End(3).Row
For I = 3 To LR
SFlg = True
WkStg = Cells(I, 1)
J = 1
While SFlg
With Application
T = Not (.IsError(.Search(StartStg & "*" & EndStg, WkStg, J)))
If (T) Then
LC = Cells(I, Columns.Count).End(xlToLeft).Column
StNb = .Search(StartStg, WkStg, J + 1) + Len(StartStg) + 1
EndNb = .Search(EndStg, WkStg, J + 1)
Cells(I, LC + 1) = Mid(WkStg, StNb, EndNb - StNb)
J = EndNb
Else
SFlg = False
End If
End With
Wend
Next I
End Sub
Display More
See the 2 files already sent and please send comments
Re: Find (Letters and Numbers) and replace cell contents
Have a look on file attached
Re: Populate Userform ListBox with unique values based upon Combo Box.
To avoid any confusion and mistake can you send a short sample of your file.
It will help for tests
Re: Auto-Populating values in month columns based on Join and End Dates
Changing row 3 with full date and using next formulas it could do the job
H4 =IF(AND((H$3>=DATE(YEAR($B4);MONTH($B4)+1;1));(H$3<=DATE(YEAR($F4);MONTH($F4)+1;1)-1));$E4/$D4;"")