I have a script that is converting a Julian Date to a Gregorian Date. I am supposed to be able to click on a range that contains my Julian Date, then select on a range where I'd like to insert my Gregorian Date. The only problem is that once I set the first selected range as JD (Julian Date), I can't seem to assign a new selected range.
For instance if I select B:B as my range of JD, then JD = 2.
Then if I select D:D for my range of GD (Gregorian Date), then GD should = 4, but it still equals 2. I'm not sure what else is going to error out after I get through with this part, but I'm stuck here for now. Can anyone provide any insight? Any help is appreciated!
Sub Julian_to_Gregorian()
Dim rng As Range, col As Range, cols As Range, arr
Dim sht As Worksheet, shet As Worksheet, hdr As Long, yn As Long, LastRow As Long
Dim dest As Range
On Error Resume Next
Set rng = Application.InputBox( _
Prompt:="Please select the column that contains the Julian Date. " & vbNewLine & _
" (e.g. Column A or Column B)", _
Title:="Select Julian Date Range", Type:=8)
On Error GoTo 0
jd = Selection.Column
'pjd = jd.Column
hdr = MsgBox("Does your selection contain a header?", vbYesNo + vbQuestion, "Header Option")
Set dest = Application.InputBox( _
Prompt:="Please select the column that the Gregorian Date will be placed in. " & vbNewLine & _
"(A new column will be inserted in this location, preserving the current data in this location.)", _
Title:="Select Destination Range", Type:=8)
gd = Selection.Column
If dest Is Nothing Then Exit Sub
'gd = Selection.Column
Set sht = dest.Parent
Set shet = rng.Parent
On Error GoTo 0
'yn = MsgBox("Do you want to insert a new column here?" & vbNewLine & _
' "(Choosing 'No' will replace the current cells in your selected range." & vbNewLine & _
' "All data in this range will be permanently deleted.)", vbYesNo + vbQuestion, "Destination Range Options")
LastRow = shet.Cells(Rows.Count, jd).End(xlUp).Row
Application.ScreenUpdating = False
'With Range(Cells(1, 3), Cells(1, 2 + Range("B1"))).EntireColumn
With Cells(1, gd).EntireColumn
.Insert Shift:=xlToRight
End With
'gd.EntireColumn.Insert xlRight
gd = gd - 1
For i = 2 To LastRow
Cells(i, gd).Value = "=DATE(IF(0+(LEFT(" & Cells(i, jd) & ",2))<30,2000,1900)+LEFT(" & Cells(i, jd) & ",2),1,RIGHT(" & Cells(i, pjd) & ",3))"
Next i
End Sub
I did not test the rest of your code, but to get the correct columns:
replace
jd = Selection.Column with jd = rng.Column
replace
gd = Selection.Columnwith gd = dest.Column
The reason your code didn't work was simple: The selection you activate during your prompts are no "real" selections in the sheet, they are only valid for the prompt. After the prompt, the selection from before the prompts will be active again and thus, jd and gd would always be equal to the column of the cell selected before executing the macro.
Related
if column F is in this date format then column K should have this code CD else error msg box my code is below does not seem to work for different date format setting in that column pls help
Sub date_check3()
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet6")
Dim lr As Long, Target As Range
lr = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
For Each Target In ws.Range("F2:F3" & lr & ",K2:K3" & lr)
If Target.NumberFormat = "mm/dd/yyyy h:mm:ss AM/PM" And Target.Offset(0, 5) <> "CD" And Target <> "" Then
MsgBox "Error" & Target.Address
End If
Next Target
End Sub
What do you mean by "does not seem to work for different date format setting"?
Your condition asks for a specific format: Target.NumberFormat = "mm/dd/yyyy h:mm:ss AM/PM"
To check if the value in a cell looks like a date in an arbitrary format, you could use following line:
If IsDate(Target) And Target.Offset(0, 5) <> "CD" And Target <> "" Then
You loop range is wrong. You just need to loop through one column. Also, since you are looping through Column F, you should update your lr calculation to check that columns range.
lr = ws.Range("K" & ws.Rows.Count).End(xlUp).ROw
For Each Target In ws.Range("F2:F" & lr)
+ last row worksheet reference updating
I'm new here and I am trying to do a VBA Vlookup function.
My objectives is to VLookup Table1 from Sheet 1 to Table2 from Sheet2 using Column A and update column B and C if A is existing.
If A is not existing to add into Table1 next blank row with column B and C also included.
Please refer below image - expectation of Sheet1 with updated results.
Thank you in advance.
Currently able to code only to update existing fields but not sure how to add fields that does not match into next blank row of Sheet1.
Sub getOpenExcel()
' Your daily report has a date in it's name
' to select an open workbook we must first know it's name
' AND - it must be already open
' Your examples are 2017-03-11-18875, 2017-03-12-18875, 2017-03-13-18875
' If the name is the current date then this would work to get the filename
Dim fileName As String, monthNum As String, dayNum As String, wb1 As Workbook, wb2 As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet, rng1 As Range, rng2 As Range
' this adds a ZERO to the front of month numbers less than 10
If Month(Date) < 10 Then
monthNum = "0" & CStr(Month(Date))
Else
monthNum = CStr(Month(Date))
End If
' You may or may not need this section
' it adds a ZERO to the front of day numbers less than 10
If Day(Date) < 10 Then
dayNum = "0" & CStr(Day(Date))
Else
dayNum = CStr(Day(Date))
End If
' many cases the daily report will come from the previous day
' If your file has yesterday's date, then comment out the above code and
'uncomment the following code
'
'If Day(DateAdd("d", -1, Date)) < 10 Then
' dayNum = "0" & Day(DateAdd("d", -1, Date))
'Else
' dayNum = Day(DateAdd("d", -1, Date))
'End If
fileName = "GREENBILL_RECON_DETAILED_REPORT_" & CStr(Year(Date)) & monthNum & dayNum
' if today's date is 3/14/17 then "fileNem" = "2017-03-12-18875"
' If your daily report is an excel book, then we need to add the proper extension.
' It could be one of many, "xls", ".xlsx" , ".xlsm", etc....
' If your daily report is open - look at the top. It should have the file name and extension.'
' Replace the below extension with the correct one.
fileName = fileName & ".csv"
' Again, if today's date is 3/14/17 then "fileNem" = "2017-03-12-18875.xlsx"
' This is where we set both workbooks to variables
'
Set wb1 = ThisWorkbook
Set ws1 = wb1.Worksheets("Sheet1")
On Error GoTo notOpen
Set wb2 = Workbooks(fileName) ' This is your daily report
On Error GoTo 0
Set ws2 = wb2.Worksheets("GREENBILL_RECON_DETAILED_REPORT")
ws1.Activate
'*************************************************************************************
' If successful this is the area where you put your code to copy and paste automatically '
' If you need this pasted to the first empty row at bottom of page then 'put code here to find the first empty row and use that varaible
' with range("a" & firstUnusedRow) intstead of A1 ...
wb2.Activate
Range("A1:Z500").Copy _
Destination:=wb1.Worksheets("Sheet1").Range("A1") 'change A1 to A &
firstUnusedRow
'*************************************************************************************
' This is the clean up and exit code
Set wb1 = Nothing
Set wb2 = Nothing
Exit Sub
notOpen:
On Error GoTo 0
Set wb1 = Nothing
MsgBox "The file " & fileName & " is not open"
Exit Sub
End Sub
Sub Rectangle3_Click()
On Error Resume Next
Dim Dept_Row As Long ' To Change to Billing_Acc
Dim Dept_Clm As Long ' To Change to Org_Seqno
Table1 = Sheet1.Range("A1:A10") ' Input file name
Table2 = Sheet2.Range("A1:B10") ' Range of table
Dept_Row = Sheet1.Range("B1").Row
Dept_Clm = Sheet1.Range("B1").Column
For Each cl In Table1
Sheet1.Cells(Dept_Row, Dept_Clm) = Application.WorksheetFunction.VLookup(cl, Table2, 2, False)
Dept_Row = Dept_Row + 1
Next cl
MsgBox "Done"
End Sub
Below code is done iterating thru all the rows by matching column A of both sheets. If not found this will add a new line in sheet1.
Dim lngRow1, lngRow2 As Long
lngRow1 = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
lngRow2 = Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
Dim isFound As Boolean
Dim lastRow As Long
Dim i, j As Long
lastRow = lngRow1
For i = 1 To lngRow2
isFound = False
For j = 1 To lngRow1
If Sheets("Sheet1").Range("A" & i) = Sheets("Sheet2").Range("A" & j) Then
Sheets("Sheet1").Range("B" & i) = Sheets("Sheet2").Range("B" & j)
Sheets("Sheet1").Range("C" & i) = Sheets("Sheet2").Range("C" & j)
isFound = True
End If
Next j
If Not isFound Then
lastRow = lastRow + 1
Sheets("Sheet1").Range("A" & lastRow) = Sheets("Sheet2").Range("A" & i)
Sheets("Sheet1").Range("B" & lastRow) = Sheets("Sheet2").Range("B" & i)
Sheets("Sheet1").Range("C" & lastRow) = Sheets("Sheet2").Range("C" & i)
End If
Next i
Code written considering the above example image. if number of columns are different than the example please modify the code accordingly.
So I wrote a VBA code to calculate the number of blanks, non-blanks and total entries under each header for some input data. I want to add a code that copies and pastes the values from one sheet to another, dedupes the values, gives me the unique list of values under each header, number of unique values, and the number of times those unique values are occurring under the header.
Blanks: I used the countblank function earlier, but it would skip certain empty fields, so I changed it to sumproduct(len(Range)=0)*1).
Non-Blanks: I wrote a similar function and tried to calculate the above.
It turns out VBA is unable to process the Sumproduct function. Here are the approaches I have tried:
1. Application.WorksheetFunction.Sumproduct(...)
2. ..Number.. = "=Sumproduct(...)"
3. ..Number.. = Evaluate("Sumproduct(...)")
4. ..Number.. = Worksheet.Evaluate("Sumproduct(...)")
Below is the code for the macro, I am writing the code on the Input_File, i.e., the Input worksheet.
Sub Dedupe()
ThisWorkbook.Worksheets("Control_Totals").Cells.ClearContents
Dim lRow As Long
Dim lCol As Long
Dim i As Long
Dim j As Long
Dim Input_File As Worksheet
Dim Output_File As Worksheet
Dim Dedup_File As Worksheet
Dim Col_Let As String
Dim Rng As String
Dim blank As String
Dim non_blank As String
Set Input_File = ThisWorkbook.Worksheets("Input")
Set Output_File = ThisWorkbook.Worksheets("Control_Totals")
Set Dedup_File = ThisWorkbook.Worksheets("Deduped")
With Output_File
.Cells(1, 1) = "Field_Name"
.Cells(1, 2) = "Blanks"
.Cells(1, 3) = "Non-Blanks"
.Cells(1, 4) = "Total"
End With
'Finding the last row among all entries, including the blank ones
lRow = Input_File.Cells.Find(What:="*", _
After:=Range("A1"), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
MsgBox "Last Row: " & lRow
'Finding the last column header/field
lCol = Input_File.Cells.Find(What:="*", _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
MsgBox "Last Column: " & lCol
i = 1
'Finding the number of blank and non-blank entries for all the fields
Do While i < lCol + 1
Col_Let = ColumnLetter(i)
Rng = "Input!" & "Col_Let" & "2" & ":" & "lRow"
Output_File.Cells(i + 1, 1) = Input_File.Cells(1, i)
blank = "SumProduct((Len(Rng) = 0) * 1)"
non_blank = "SumProduct((Len(Rng) > 0) * 1)"
Output_File.Cells(i + 1, 2).Value = Evaluate(blank)
Output_File.Cells(i + 1, 3).Value = Evaluate(non_blank)
Output_File.Cells(i + 1, 4) = lRow - 1
'Deduping the data under the headers
j = 0
For j = 1 To lRow
Dedup_File.Cells(j, i).Value = Input_File.Cells(j, i).Value
j = j + 1
Next
Dedup_File.Range(Cells(1, i), Cells(lRow, i)).RemoveDuplicates Columns:=1, _
Header:=xlYes
i = i + 1
Loop
End Sub
These lines don't do what you think they do
Col_Let = ColumnLetter(i)
Rng = "Input!" & "Col_Let" & "2" & ":" & "lRow"
Rng is always a string containing "Input!Col_Let2:lRow"
What you meant was: (I think)
Rng = "Input!" & Col_Let & "2" & ":" & Col_Let & lRow
Secondly Rng exists only within this vba routine - it doesn't mean anything to Excel so you can't use it in an Excel Formula. You need
blank = "SumProduct((Len(" & Rng.address & ") = 0) * 1)"
and finally SumProduct doesn't like those sort of tricks in VBA (It relies on excel expanding the 1 into an array automatically). A better solution:
Dim cBlank as long
Dim cNonBlank as long
Dim r as range
For each r in rng
if r.text = "" then
cBlank= cBlank+1
else
cNonBlank = cNonBlank +1
end if
next r
I want to add a code that copies and pastes the values from one sheet to another, dedupes the values, gives me the unique list of values under each header, number of unique values, and the number of times those unique values are occurring under the header.
What you have just described there is a PivotTable, with the field of interest in both the Rows area and in the Values area as a Count.
Even though I thought this would be a common question, I have searched and can't seem to find an answer.
I have a work schedule and I'd like to search the today's date and return all the names of those who are scheduled to work today. I built a code that works but it takes a long time to complete and is not 100% effective every time its run. I am sure there must be a better and faster way to do this but I have not yet been able to find one. I have it broken apart into two different codes. The first one finds the column where today's date is located and the second one gathers the names and places them onto the next sheet.
Here's the First Sub:
Sub GetDateRow_()
'//////Finds the row that has today's date and returns the value of that row to cell C34\\\\\\
Dim SearchMe As Integer
SearchMe = Sheets("Sheet1").Range("C33")
Set FindMe = Sheets("Sheet1").Range("C5:AD5").Find(What:=SearchMe, LookIn:=xlValues, LookAt:= _
xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False)
Sheets("Sheet1").Range("C34").Value = Cells(1, FindMe.Column)
End Sub
And the Second Sub:
Sub CopyScheduledToList()
'//////Searches Today's day Column from the schedule given by GetDateRow Sub & assimbles \\\\\\\
'////// the names of those who are scheduled to work today to a list on Page 2 \\\\\\\
Dim Ccount As Integer
Dim lngLoop As Long
Dim RowCount As Integer
Dim dShift As String
Dim cShift As String
Ccount = 1
dShift = "A63"
cShift = "TLA"
RowCount = Sheets("Sheet1").Range("C34").Value
lngLoop = 1
For lngLoop = 1 To Rows.count
If Cells(lngLoop, RowCount).Value = cShift Then Worksheets("Sheet2").Cells(1, 4).Value = Worksheets("Sheet1").Cells(lngLoop, 1).Value
'////// Get's the Team Leader and places name into column D on Page 2
If Cells(lngLoop, RowCount).Value = dShift Then Worksheets("Sheet2").Cells(Ccount, 1).Value = Worksheets("Sheet1").Cells(lngLoop, 1).Value
If Worksheets("Sheet2").Range("A" & Ccount).Value <> "" Then Ccount = Ccount + 1
'////// Places the name from the working list onto page 2 and adds a count so the next value found
'////// will go to the next empty row on Sheet 2
Next lngLoop
End Sub
Again, your help is greatly appreciated!
Your excessively long run times will be due to looping over 1048576 cells in your For lngLoop = 1 To Rows.count loop. That can be improved by just processing as far as the last cell that contains data in the applicable column.
The problem of it not always working correctly is almost certainly due to the fact that you have some Cells references which aren't qualified with the sheet that you want to use, and therefore they refer to the ActiveSheet.
Sub GetDateRow_()
'//////Finds the row that has today's date and returns the value of that row to cell C34\\\\\\
Dim SearchMe As Date
Dim FindMe As Range
With Worksheets("Sheet1")
SearchMe = .Range("C33").Value
Set FindMe = .Range("C5:AD5").Find(What:=SearchMe, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)
If FindMe Is Nothing Then
MsgBox "Date not found!"
Else
'I think this line
'.Range("C34").Value = .Cells(1, FindMe.Column).Value
'should be
.Range("C34").Value = FindMe.Column
'so that it saves the column number you want
End If
End With
End Sub
Sub CopyScheduledToList()
'//////Searches Today's day Column from the schedule given by GetDateRow Sub & assembles \\\\\\\
'////// the names of those who are scheduled to work today to a list on Page 2 \\\\\\\
Dim Ccount As Integer
Dim lngLoop As Long
Dim TodaysCol As Long
Dim dShift As String
Dim cShift As String
Dim lastRow As Long
Dim wsSrc As Worksheet
Dim wsDst As Worksheet
Ccount = 1
dShift = "A63"
cShift = "TLA"
Set wsSrc = Worksheets("Sheet1")
Set wsDst = Worksheets("Sheet2")
TodaysCol = wsSrc.Range("C34").Value
'Find last used row in today's column
lastRow = wsSrc.Cells(wsSrc.Rows.Count, TodaysCol).End(xlUp).Row
For lngLoop = 1 To lastRow
If wsSrc.Cells(lngLoop, TodaysCol).Value = cShift Then
wsDst.Cells(1, "D").Value = wsSrc.Cells(lngLoop, "A").Value
End If
'////// Get's the Team Leader and places name into column D on Page 2
If wsSrc.Cells(lngLoop, TodaysCol).Value = dShift Then
If wsSrc.Cells(lngLoop, "A").Value <> "" Then
wsDst.Cells(Ccount, "A").Value = wsSrc.Cells(lngLoop, "A").Value
Ccount = Ccount + 1
End If
End If
'////// Places the name from the working list onto page 2 and adds a count so the next value found
'////// will go to the next empty row on Sheet 2
Next lngLoop
End Sub
Your first sub is, in fact, a function (or should be) which returns a value which can be assigned to a variable in your second sub. The following code realises that concept. It is different in other respects too, but I think you will like it. Please try.
Option Explicit
Sub CopyScheduledToList()
'//////Searches Today's day Column from the schedule given by GetDateRow Sub & assambles \\\\\\\
'////// the names of those who are scheduled to work today to a list on Page 2 \\\\\\\
' it is best practise, not to have any hard-coded addresses in the code.
' Therefore it is good to place all parameters separate from and before the code:
Const SearchRow As Long = 5
Const dShift As String = "A63"
Const cShift As String = "TLA"
Dim WsMain As Worksheet ' better to set your own variable
Dim WsOutput As Worksheet ' even if it will be "ActiveSheet"
Dim TgtColumn As Long
Dim Rlast As Long ' last data row in WsMain
Dim Rcount As Long ' output row counter
Dim R As Long
Set WsMain = ActiveSheet ' might be Sheets("Sheet1")
Set WsOutput = Worksheets("Sheet2") ' or, simply, Sheet1
TgtColumn = DateColumn(WsMain, SearchRow)
If TgtColumn < 1 Then Exit Sub
Rcount = 1
With WsMain
Rlast = .Cells(.Rows.Count, TgtColumn).End(xlUp).Row
For R = 1 To Rlast
Select Case .Cells(R, TgtColumn).value
Case cShift
'////// Get's the Team Leader and places name into column D on WsOutput
WsOutput.Cells(Rcount, "D").value = .Cells(R, 1).value
Case dShift
WsOutput.Cells(Rcount, "A").value = .Cells(R, 1).value
Case Else
Exit Sub ' define the correct response if neither is found
End Select
If Len(WsOutput.Cells(Rcount, "A").value) Then Rcount = Rcount + 1
'////// Places the name from the working list onto page 2 and adds a count so the next value found
'////// will go to the next empty row on Sheet 2
Next R
End With
End Sub
Private Function DateColumn(Ws As Worksheet, _
ByVal SearchRow As Long) As Long
' returns the row that has today's date
' return 0 if not found
Dim SearchMe As Variant
Dim TgtDate As String
Dim Fnd As Range
If SearchRow < 1 Then Exit Function
Do
TgtDate = InputBox("Enter the target date", _
"List shift workers", _
Format(Date, "Short Date"))
' you can also set the default like Format(Date + 1, "d/m/yy")
' the sample date format must match your regional settings
If IsDate(TgtDate) Then
SearchMe = CDate(TgtDate)
' SearchMe will have the date in the format set
' in your regional settings
Exit Do
Else
MsgBox "Please enter a valid date" & vbCr & _
"in d-m-yy format", vbExclamation, "Invalid date"
' adjust the required format to your regional settings
End If
Loop While Len(TgtDate) ' enter blank or press Cancel to exit
Set Fnd = Ws.Rows(SearchRow).Find(What:=SearchMe, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)
If Not Fnd Is Nothing Then DateColumn = Fnd.Column
End Function
I have the following code so far based on questions asked by other people.
I have a set of names listed in column A, and 216 columns and 9725 rows of data.
Currently using the following code I get the new sheets created except along with the unique names and its relevant data I get many cells filled with "#N/A".
In certain cases, the name Bob for example will be populated in a new sheet called Bob but the first column will have Bob and all relevant data and once all Bobs rows are shown it is follower with many rows with #N/A and all columns with #N/A.
In other cases the sheet will be created for Charles and all of Charles data will be listed, then many rows of #N/A and then all of the master-data including other peoples names which I need to avoid.
I want each individual sheet to only have the info based on the name of the person on that sheet. All of the data gets copied as I verified the number of accurate cells that get populated yet I get these #N/A cells and duplicated extra data and I'm not sure how to stop it from being populated? Any help in cleaning the code would be appreciated!!
Code:
Sub CopyDataFromReportToIndividualSheets()
Dim ws As Worksheet
Set ws = Sheets("FormulaMSheet2")
Dim LastRow As Long
Dim MyRange As Range
Worksheets("FormulaMSheet2").Activate
LastRow = Range("A" & ws.Rows.Count).End(xlUp).Row
' stop processing if we don't have any data
If LastRow < 2 Then Exit Sub
Application.ScreenUpdating = False
' SortMasterList LastRow, ws
CopyDataToSheets LastRow, ws
ws.Select
Application.ScreenUpdating = True
End Sub
Sub SortMasterList(LastRow As Long, ws As Worksheet)
ws.Range("A2:BO" & LastRow).Sort Key1:=ws.Range("A1")
', Key2:=ws.Range("B1")
End Sub
Sub CopyDataToSheets(LastRow As Long, src As Worksheet)
Dim allAgentNameCells As Range
Dim cell As Range
Dim Series As String
Dim SeriesStart As Long
Dim SeriesLast As Long
Set allAgentNameCells = Range("A2:A" & LastRow)
SeriesStart = 2
Series = Range("A" & SeriesStart).Value
For Each cell In allAgentNameCells
If cell.Value <> " " And cell.Value <> "" Then
' Condition ` And cell.Value <> "" ` added for my testdata. If you don't need this, please remove.
' Current Row's Series not SPACE
If cell.Value <> Series Then
SeriesLast = cell.Row - 1
CopySeriesToNewSheet src, SeriesStart, SeriesLast, Series
Series = cell.Value
SeriesStart = cell.Row
End If
End If
Next
'' copy the last series
SeriesLast = LastRow
CopySeriesToNewSheet src, SeriesStart, SeriesLast, Series
End Sub
Sub CopySeriesToNewSheet(src As Worksheet, Start As Long, Last As Long, name As String)
Dim tgt As Worksheet
Dim MyRange As Range
If (SheetExists(name)) Then
MsgBox "Sheet " & name & " already exists. " _
& "Please delete or move existing sheets before" _
& " copying data from the Master List.", vbCritical, _
"Time Series Parser"
End
Else
If Series = " " Then
End
End If
End If
Worksheets("FormulaMSheet2").Activate
' Worksheets.Add(after:=Worksheets(Worksheets.Count)).name = name
Worksheets("FormulaMSheet2").Copy After:=Worksheets(Worksheets.Count)
ActiveSheet.name = name
Set tgt = Sheets(name)
' copy data from src to tgt
tgt.Range("A2:BO2" & Last - Start + 2).Value = src.Range("A" & Start & ":BO" & Last).Value
End Sub
Function SheetExists(name As String) As Boolean
Dim ws As Variant
For Each ws In ThisWorkbook.Sheets
If ws.name = name Then
SheetExists = True
Exit Function
End If
Next
SheetExists = False
End Function
You need replace the
tgt.Range("A2:BO2" & Last - Start + 2).Value = src.Range("A" & Start & ":BO" & Last).Value
to
src.Range("A" & Start & ":BO" & Last).SpecialCells(xlCellTypeVisible).Copy Destination:=tgt.Range("A2:BO2" & Last - Start + 2)
I found what I needed at the following site: http://www.rondebruin.nl/win/s3/win006_5.htm .
I figured if anyone else was looking for similar code it would help taking a look at the site.