Unsigned Uncosigned Notes 2022

This works: 9.6.22 version -- with Submit button -- excel file is here

Here is the PHI template to accompany the above file

Trim Leading Spaces Column A

Option Explicit
Sub TrimLeadingSpacesColumnA()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Data")

     Dim r As Range
     'Set r = Application.Intersect(ws.Range("A1:A" & ws.Rows.Count), ws.UsedRange)
     Set r = Application.Intersect(ws.Range("A1:C" & ws.Rows.Count), ws.UsedRange)
        
     Dim c As Range
     For Each c In r
         c.Value = LTrim(c.Value)
     Next     
    
 End Sub

Delete Specific Rows

Option Explicit

Sub deleteSpecificRows2()
    Dim c As Range
    Dim SrchRng As Range
    Dim SrchStr As String
    Dim i As Integer

Dim myarray()

myarray = Array("DEVICE", _
"Unsigned and", _
"PRINTED", _
"AUG 23", _
"-----", _
"AUTHOR", _
"Totals")

    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Data")

    Set SrchRng = ws.Range("A1", ws.Range("A65536").End(xlUp))
    'SrchStr = InputBox("Please Enter A Search String")
    
    For i = LBound(myarray) To UBound(myarray)
    Do
        Set c = SrchRng.Find(myarray(i), LookIn:=xlValues)
        If Not c Is Nothing Then c.EntireRow.Delete
    Loop While Not c Is Nothing
    Next i

End Sub

Hyperlink Table of Contents

Option Explicit
Sub hyperlinkTOC()
Dim i As Integer
Sheets.Add(before:=Sheets(1)).Name = "Table of Contents"
Worksheets("Table of Contents").Range("A1").Value = "Click on any of the below links to view that clinical area"
'Sheets.Add Before:=Sheets(1)
For i = 2 To Worksheets.Count
ActiveSheet.Hyperlinks.Add _
Anchor:=Cells(i, 1), _
Address:="", _
SubAddress:="'" & Worksheets(i).Name & "'!A1", _
TextToDisplay:=Worksheets(i).Name
Next i
Worksheets("Table of Contents").Columns("A:A").AutoFit
End Sub

Sort Worksheets

Option Explicit
Sub SortWorksheetsTabs()
Application.ScreenUpdating = False
Dim ShCount As Integer, i As Integer, j As Integer
ShCount = Sheets.Count

For i = 1 To ShCount - 1
    For j = i + 1 To ShCount
        If UCase(Sheets(j).Name) < UCase(Sheets(i).Name) Then
            Sheets(j).Move before:=Sheets(i)
        End If
    Next j
Next i

Application.ScreenUpdating = True
End Sub

Remove Slash

Option Explicit

Sub removeSlashes()
Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Data")
ws.Cells.Replace "~/", ""
End Sub

or. . .

Sub removeSlashes()
ActiveSheet.Cells.Replace "~/", ""
End Sub

Find Duplicates in Column A

Option Explicit

Sub findDuplicatesInColumn_A_doSomething1()

Dim ws As Worksheet
Set ws = ActiveWorkbook.Worksheets("Data")
ws.Activate

'Declaring the lastRow variable as Long to store the last row value in the Column1
    Dim lastRow As Long

'matchFoundIndex is to store the match index values of the given value
    Dim matchFoundIndex As Long

'iCntr is to loop through all the records in the column 1 using For loop
    Dim i As Long

'Finding the last row in the Column 1
    lastRow = Range("A65000").End(xlUp).Row

'looping through the column1
    For i = 1 To lastRow
        'checking if the cell is having any item, skipping if it is blank.
        If Cells(i, 1) <> "" Then
            'getting match index number for the value of the cell
            matchFoundIndex = WorksheetFunction.Match(Cells(i, 1), Range("A1:A" & lastRow), 0)
            'if the match index is not equal to current row number, then it is a duplicate value
            If i <> matchFoundIndex Then
                'Prints the "duplicate" label in column B
                'Cells(i, 2) = "Duplicate"
                
            'MsgBox Cells(i, 1).Value
            Cells(i, 1).Value = Cells(i, 1).Value & "0" 'add "0" to end of the cell's value
            
            End If
        End If
    Next
End Sub
'source: https://analysistabs.com/vba/find-duplicate-values-column/

or. . .
Sub findDuplicatesInColumn_A()
'Declaring the lastRow variable as Long to store the last row value in the Column1
    Dim lastRow As Long

'matchFoundIndex is to store the match index values of the given value
    Dim matchFoundIndex As Long

'iCntr is to loop through all the records in the column 1 using For loop
    Dim i As Long

'Finding the last row in the Column 1
    lastRow = Range("A65000").End(xlUp).Row

'looping through the column1
    For i = 1 To lastRow
        'checking if the cell is having any item, skipping if it is blank.
        If Cells(i, 1) <> "" Then
            'getting match index number for the value of the cell
            matchFoundIndex = WorksheetFunction.Match(Cells(i, 1), Range("A1:A" & lastRow), 0)
            'if the match index is not equals to current row number, then it is a duplicate value
            If i <> matchFoundIndex Then
                'Prints the "duplicate" label in column B
                Cells(i, 2) = "Duplicate"
            End If
        End If
    Next
End Sub
'source: https://analysistabs.com/vba/find-duplicate-values-column/

Match Filter May9

Option Explicit
Sub matchFilterMay9()

   ' using sheet named "Data" in the workbook
   Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Data")

   ' im assuming no header
   ' remove Dim lastRowA As Integer: lastRowA = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row '1 means column A
   Dim lastRowC As Integer: lastRowC = ws.Cells(ws.Rows.Count, 3).End(xlUp).Row '3 means column C

   Dim i As Integer, j As Integer, k As Integer
   Dim startRow As Long
   
    Dim matchMe As String, newString As String, marks As String
    Dim myarray As Variant
    myarray = Array("SERVICE: EVANSTON CBOC", "SERVICE: ASSOCIATE DIR DENTAL SERVICES", "SERVICE: ASSOCIATE DIR FLEET MEDICINE", _
     "SERVICE: AUDIOLOGSPEECH PATH.", "SERVICE: CARDIOLOGY SECTION", "SERVICE: CHIEF MEDICAL EXECUTIVE", "SERVICE: COMMAND SUITE", _
     "SERVICE: COMMUNITY LIVING CENTER", "SERVICE: CRITICAL CARE SECTION", "SERVICE: DENTAL", "SERVICE: DERMATOLOGY SECTION", _
     "SERVICE: DOMICILIARY SERVICE", "SERVICE: EDUCATION", "SERVICE: EMERGENCY DEPARTMENT", "SERVICE: ENDOCRINOLOGY SECTION", _
     "SERVICE: ACUTE INPATIENT", "SERVICE: FACILITY MANAGEMENT SERVICE", "SERVICE: FISHER BRANCH CLINIC - 237", _
     "SERVICE: GASTROENTEROLOGY SECTION", "SERVICE: GENERAL SURGERY", "SERVICE: GERIATRICS & EXTENDED CARE", _
     "SERVICE: GERIATRICS & EXTENDED CARE0", "SERVICE: HEALTH CARE BUSINESS", "SERVICE: HOME COMMUNITY BASED CARE", _
     "SERVICE: IMAGING SERVICE", "SERVICE: INFECTION CONTROL", "SERVICE: INFECTIOUS DISEASE SECTION", _
     "SERVICE: INPATIENT ACUTE CARE & ICU", "SERVICE: INPATIENT SERVICES", "SERVICE: INTERNAL MEDICINE", _
     "SERVICE: INTERNAL MEDICINE0", "SERVICE: KENOSHA CLINIC", "SERVICE: KENOSHA CLINIC0", "SERVICE: LABORATORY SERVICE", _
 "SERVICE: MADISON TELEPHONE OPERATIONS", "SERVICE: MANAGED CARE OPERATIONS", "SERVICE: MEDICAL SERVICE", _
 "SERVICE: MEDICAL SERVICES", "SERVICE: MEDICINE", "SERVICE: Medicine Services", "SERVICE: MEDICINE0", _
 "SERVICE: MEDICINE1", "SERVICE: MEDICINE2", "SERVICE: MENTAL HEALTH CLINIC1", "SERVICE: MENTAL HEALTH CLINIC", _
 "SERVICE: MENTAL HEALTH CLINIC0", "SERVICE: MENTAL HEALTH SERVICE", "SERVICE: MENTAL HEALTH TEAM A", _
 "SERVICE: NEPHROLOGY SECTION", "SERVICE: NEUROLOGY SERVICE", "SERVICE: NURSING SERVICE", "SERVICE: NUTRITION AND FOOD SERVICE", _
 "SERVICE: OCC DELIVERY OPS", "SERVICE: OCCUPATIONAL HEALTH MEDICINE", "SERVICE: OFFICE OF PERFORMANCE IMP", "SERVICE: OPERATING ROOM", _
 "SERVICE: OPHTHALMOLOGY SECTION", "SERVICE: OPTOMETRY SECTION", "SERVICE: ORTHOPEDIC SECTION", "SERVICE: OUTPATIENTCONSULTATION", _
 "SERVICE: PATIENT ADMINISTRATION SERVICE", "SERVICE: PATIENT ALIGNED CARE TEAM", "SERVICE: PATIENT ALIGNED CARE TEAM0", _
"SERVICE: PATIENT ALIGNED CARE TEAM1", "SERVICE: PEDIATRICS", "SERVICE: PHARMACY SERVICE", "SERVICE: PHARMACY SERVICE0", _
"SERVICE: PHARMACY SERVICE1", "SERVICE: PHYSICAL THERAPY", "SERVICE: PODIATRY SECTION", "SERVICE: PRIMARY CARE DIR (MHPPACT)", _
"SERVICE: PROSTHETICS & SENSORY AID", "SERVICE: PULMONARY DISEASE SECTION", "SERVICE: PULMONARY DISEASE SECTION0", _
"SERVICE: RADIOLOGY SECTION", "SERVICE: REHABILITATION", "SERVICE: REMOTE", "SERVICE: RESOURCES MANAGEMENT", "SERVICE: ROCKFORD", _
"SERVICE: SARPATP", "SERVICE: SOCIAL WORK", "SERVICE: SPECIAL MEDICAL EXAMS", "SERVICE: SPECIAL PROGRAMS", "SERVICE: SPECIALTY MEDICINE", _
"SERVICE: Surgery", "SERVICE: SURGICAL SERVICE", "SERVICE: UNKNOWN", "SERVICE: UROLOGY", "SERVICE: USS TRANQUILITY - 1007", _
"SERVICE: VISTA APPLICATIONS SUPPORT", "SERVICE: WOMEN'S PRIMARY CARE")

Sheets.Add.Name = "MedicineMerged"
Sheets.Add.Name = "SurgeryMerged"
Sheets.Add.Name = "DentalMerged"
Sheets.Add.Name = "AncillaryMerged"
Sheets.Add.Name = "CLCMerged"
Sheets.Add.Name = "CMECmdSteMerged"
Sheets.Add.Name = "FleetMerged"
Sheets.Add.Name = "InPtICUmerged"
Sheets.Add.Name = "MHmerged"
Sheets.Add.Name = "PCmerged"
Sheets.Add.Name = "PtAdminMerged"
Sheets.Add.Name = "Nursing"
Sheets.Add.Name = "FacilityMgmt"

For i = LBound(myarray) To UBound(myarray)
'   remove1 For i = 1 To lastRowA
'   remove matchMe = ws.Cells(i, 1).Value

   
       For j = 1 To lastRowC
       
       marks = ws.Cells(j, 3).Value
       
    If marks = myarray(i) Then
    
               'ws.Cells(i, 1).Interior.Color = vbRed
               'Debug.Print j 'prints matching row number to Immediate window
               'newString = Replace(ws.Cells(j, 3).Value, "SERVICE: ", "")
               'Worksheets.Add.Name = newString
               'Debug.Print newString
               'Sheets.Add.Name = newString
               
            Debug.Print ws.Cells(j, 3).Address
            
            Dim Var1 As Range
            Dim Var2 As Range, sText As Variant
  
                Set Var1 = ws.Cells(j, 3)
                Set Var2 = Var1.End(xlDown)
                Debug.Print Var1.Address
                Debug.Print Var2.Address
                
Dim strAddress1 As String, strAddress2 As String
Dim rownum1 As Long, rownum2 As Long
 
strAddress1 = Var1.Address
 strAddress2 = Var2.Address
 rownum1 = Range(strAddress1).Row 'yields the row number of the cell's address
rownum2 = Range(strAddress2).Row
Debug.Print rownum1
Debug.Print rownum2

ws.Activate
'ws.Range("C" & rownum1 & ":" & "C" & rownum2).Select
If ws.Range("C" & rownum1 + 1) <> "" Then
     ws.Range("D" & rownum1 + 1 & ":" & "D" & rownum2) = ws.Range("C" & rownum1)
     'ws.Range("C" & rownum1 & ":" & "C" & rownum2).Copy Worksheets(newString).Range("A1") 'this is the magic
     'ws.Range("D" & rownum1 & ":" & "D" & rownum2).Copy Worksheets(newString).Range("B1") 'this is the magic
     'ws.Range("C" & rownum1) = ""     'deletes header for clinic section in sheet "Data"
     'Worksheets(newString).Columns("A:B").EntireColumn.AutoFit
     
     Dim marks1 As String
     marks1 = ws.Range("C" & rownum1).Value
     'If ws.Range("C" & rownum1).Value = "SERVICE: GASTROENTEROLOGY SECTION" Then
     If marks1 = "SERVICE: GASTROENTEROLOGY SECTION" Or marks1 = "SERVICE: ENDOCRINOLOGY SECTION" _
     Or marks1 = "SERVICE: CARDIOLOGY SECTION" Or marks1 = "SERVICE: DERMATOLOGY SECTION" _
     Or marks1 = "SERVICE: EMERGENCY DEPARTMENT" Or marks1 = "SERVICE: INFECTIOUS DISEASE SECTION" _
     Or marks1 = "SERVICE: MEDICINE" Or marks1 = "SERVICE: MEDICINE0" Or marks1 = "SERVICE: MEDICINE1" _
     Or marks1 = "SERVICE: MEDICINE2" Or marks1 = "SERVICE: Medicine Services" Or marks1 = "SERVICE: NEPHROLOGY SECTION" _
     Or marks1 = "SERVICE: NEUROLOGY SERVICE" Or marks1 = "SERVICE: PULMONARY DISEASE SECTION" Or marks1 = "SERVICE: PULMONARY DISEASE SECTION0" _
     Or marks1 = "SERVICE: SPECIALTY MEDICINE" Then
      
     ws.Range("C" & rownum1 & ":" & "C" & rownum2).Copy Worksheets("MedicineMerged").Cells(Rows.Count, 1).End(xlUp)(2).Offset(1, 0)
     ' no no ws.Range("C" & rownum1 & ":" & "C" & rownum2).Copy Worksheets("MedicineMerged").Cells(Rows.Count, 1).End(xlUp)(2)
     
     Else
     Debug.Print "No"

     End If
     
     'code above is OK
     
     If marks1 = "SERVICE: GENERAL SURGERY" Or marks1 = "SERVICE: OPERATING ROOM" _
     Or marks1 = "SERVICE: OPHTHALMOLOGY SECTION" Or marks1 = "SERVICE: ORTHOPEDIC SECTION" _
     Or marks1 = "SERVICE: PODIATRY SECTION" Or marks1 = "SERVICE: Surgery" _
     Or marks1 = "SERVICE: SURGICAL SERVICE" Or marks1 = "SERVICE: UROLOGY" Or marks1 = "SERVICE: UROLOGY0" Then

     ws.Range("C" & rownum1 & ":" & "C" & rownum2).Copy Worksheets("SurgeryMerged").Cells(Rows.Count, 1).End(xlUp)(2).Offset(1, 0)
     
     Else
     Debug.Print "No"
     
     End If
     
     If marks1 = "SERVICE: ASSOCIATE DIR DENTAL SERVICES" Or marks1 = "SERVICE: DENTAL" Then

     ws.Range("C" & rownum1 & ":" & "C" & rownum2).Copy Worksheets("DentalMerged").Cells(Rows.Count, 1).End(xlUp)(2).Offset(1, 0)
     
     Else
     Debug.Print "No"
     
     End If
     
     If marks1 = "SERVICE: AUDIOLOGSPEECH PATH." Or marks1 = "SERVICE: IMAGING SERVICE" _
     Or marks1 = "SERVICE: LABORATORY SERVICE" Or marks1 = "SERVICE: NUTRITION AND FOOD SERVICE" _
     Or marks1 = "SERVICE: OPTOMETRY SECTION" Or marks1 = "SERVICE: PHARMACY SERVICE" _
     Or marks1 = "SERVICE: PHARMACY SERVICE0" Or marks1 = "SERVICE: PHARMACY SERVICE1" _
     Or marks1 = "SERVICE: PHYSICAL THERAPY" Or marks1 = "SERVICE: PROSTHETICS & SENSORY AID" _
     Or marks1 = "SERVICE: RADIOLOGY SECTION" Or marks1 = "SERVICE: REHABILITATION" Then

     ws.Range("C" & rownum1 & ":" & "C" & rownum2).Copy Worksheets("AncillaryMerged").Cells(Rows.Count, 1).End(xlUp)(2).Offset(1, 0)
     
     Else
     Debug.Print "No"
     
     End If
     
     If marks1 = "SERVICE: GERIATRICS & EXTENDED CARE" Or marks1 = "SERVICE: GERIATRICS & EXTENDED CARE0" Then

     ws.Range("C" & rownum1 & ":" & "C" & rownum2).Copy Worksheets("CLCMerged").Cells(Rows.Count, 1).End(xlUp)(2).Offset(1, 0)
     
     Else
     Debug.Print "No"
     
     End If
     
     If marks1 = "SERVICE: CHIEF MEDICAL EXECUTIVE" Or marks1 = "SERVICE: COMMAND SUITE" _
     Or marks1 = "SERVICE: INFECTION CONTROL" Or marks1 = "SERVICE: OCC DELIVERY OPS" _
     Or marks1 = "SERVICE: OFFICE OF PERFORMANCE IMP" Then

     ws.Range("C" & rownum1 & ":" & "C" & rownum2).Copy Worksheets("CMECmdSteMerged").Cells(Rows.Count, 1).End(xlUp)(2).Offset(1, 0)
     
     Else
     Debug.Print "No"
     
     End If
     
     If marks1 = "SERVICE: ASSOCIATE DIR FLEET MEDICINE" Or marks1 = "SERVICE: FISHER BRANCH CLINIC - 237" _
     Or marks1 = "SERVICE: OCCUPATIONAL HEALTH MEDICINE" Or marks1 = "SERVICE: USS TRANQUILITY - 1007" Then

     ws.Range("C" & rownum1 & ":" & "C" & rownum2).Copy Worksheets("FleetMerged").Cells(Rows.Count, 1).End(xlUp)(2).Offset(1, 0)
     
     Else
     Debug.Print "No"
     
     End If
     
     If marks1 = "SERVICE: ACUTE INPATIENT" Or marks1 = "SERVICE: CRITICAL CARE SECTION" _
     Or marks1 = "SERVICE: INPATIENT ACUTE CARE & ICU" Or marks1 = "SERVICE: INPATIENT SERVICES" _
     Or marks1 = "SERVICE: INTERNAL MEDICINE" Or marks1 = "SERVICE: INTERNAL MEDICINE0" Then

     ws.Range("C" & rownum1 & ":" & "C" & rownum2).Copy Worksheets("InPtICUmerged").Cells(Rows.Count, 1).End(xlUp)(2).Offset(1, 0)
     
     Else
     Debug.Print "No"
     
     End If
     
      If marks1 = "SERVICE: DOMICILIARY SERVICE" Or marks1 = "SERVICE: MENTAL HEALTH CLINIC" _
     Or marks1 = "SERVICE: MENTAL HEALTH CLINIC0" Or marks1 = "SERVICE: MENTAL HEALTH CLINIC1" _
     Or marks1 = "SERVICE: MENTAL HEALTH SERVICE" Or marks1 = "SERVICE: MENTAL HEALTH TEAM A" _
     Or marks1 = "SERVICE: SARPATP" Or marks1 = "SERVICE: SOCIAL WORK" Then

     ws.Range("C" & rownum1 & ":" & "C" & rownum2).Copy Worksheets("MHmerged").Cells(Rows.Count, 1).End(xlUp)(2).Offset(1, 0)
     
     Else
     Debug.Print "No"
     
     End If
     
      If marks1 = "SERVICE: EVANSTON CBOC" Or marks1 = "SERVICE: EVANSTON CBOC0" _
     Or marks1 = "SERVICE: KENOSHA CLINIC" _
     Or marks1 = "SERVICE: KENOSHA CLINIC0" Or marks1 = "SERVICE: PATIENT ALIGNED CARE TEAM" _
     Or marks1 = "SERVICE: PATIENT ALIGNED CARE TEAM0" Or marks1 = "SERVICE: PATIENT ALIGNED CARE TEAM1" _
     Or marks1 = "SERVICE: PEDIATRICS" Or marks1 = "SERVICE: PRIMARY CARE DIR (MHPPACT)" _
     Or marks1 = "SERVICE: WOMEN'S PRIMARY CARE" Then

     ws.Range("C" & rownum1 & ":" & "C" & rownum2).Copy Worksheets("PCmerged").Cells(Rows.Count, 1).End(xlUp)(2).Offset(1, 0)
     
     Else
     Debug.Print "No"
     
     End If
     
      If marks1 = "SERVICE: EDUCATION" Or marks1 = "SERVICE: HEALTH CARE BUSINESS" _
     Or marks1 = "SERVICE: MADISON TELEPHONE OPERATIONS" Or marks1 = "SERVICE: OUTPATIENTCONSULTATION" _
     Or marks1 = "SERVICE: PATIENT ADMINISTRATION SERVICE" Or marks1 = "SERVICE: REMOTE" _
     Or marks1 = "SERVICE: RESOURCES MANAGEMENT" Or marks1 = "SERVICE: ROCKFORD" _
     Or marks1 = "SERVICE: UNKNOWN" Or marks1 = "SERVICE: VISTA APPLICATIONS SUPPORT" Then

     ws.Range("C" & rownum1 & ":" & "C" & rownum2).Copy Worksheets("PtAdminMerged").Cells(Rows.Count, 1).End(xlUp)(2).Offset(1, 0)
     
     Else
     Debug.Print "No"
     
     End If
     
     If marks1 = "SERVICE: NURSING SERVICE" Then

     ws.Range("C" & rownum1 & ":" & "C" & rownum2).Copy Worksheets("Nursing").Cells(Rows.Count, 1).End(xlUp)(2).Offset(1, 0)
     
     Else
     Debug.Print "No"
     
     End If
     
     If marks1 = "SERVICE: FACILITY MANAGEMENT SERVICE" Then

     ws.Range("C" & rownum1 & ":" & "C" & rownum2).Copy Worksheets("FacilityMgmt").Cells(Rows.Count, 1).End(xlUp)(2).Offset(1, 0)
     
     Else
     Debug.Print "No"
     
     End If
     'code below is OK
     
Else
     Debug.Print "Else"
'     Sheets(newString).Activate
'     ws.Range("D" & rownum1 + 1 & ":" & "D" & rownum2) = ws.Range("C" & rownum1)
'     ws.Range("C" & rownum1).Copy Worksheets(newString).Range("A1") 'this is the magic
'     ws.Range("D" & rownum1 & ":" & "D" & rownum2).Copy Worksheets(newString).Range("B1") 'this is the magic
'     Worksheets(newString).Columns("A:B").EntireColumn.AutoFit
'               Dim lastrowNewString As Long
'                lastrowNewString = Cells(Rows.Count, "A").End(xlUp).Row - 1
'                Range("M1") = lastrowNewString
End If
'Worksheets(newString).Activate
            ' doesnt work-- Worksheets(newString).Range("A1") = ws.Range("C" & rownum1 & ":" & "C" & rownum2)
            ' doesnt work-- Worksheets(newString).Range("A1") = ws.Range("C" & rownum1 & ":" & "C" & rownum2)
            ' doesnt work-- ws.Cells("C" & rownum).Select
            ' doesnt work-- ws.Cells("C" & j).Select
                
            ' doesnt work-- ws.Range(Var1.Address & ":" & Var2.Address).Select
            ' doesnt work-- Range(Var1.Address & ":" & Var2.Address).Value = Worksheets(newString).Range("A1)
            
            ' doesnt work--Range(Var1.Address & ":" & Var2.Address).Copy Worksheets(newString).Range("A1")
            
               
               '--code below is OK -- for j = 1
'               Sheets(newString).Activate
'
'                lastrowNewString = Cells(Rows.Count, "A").End(xlUp).Row - 1
'                Range("M1") = lastrowNewString
'
'                Worksheets("CountsByClinic").Activate
'                    With Range("B1")
'                        .Value = Date
'                        .NumberFormat = "mm/dd/yy"
'                    End With
'                Worksheets("CountsByClinic").Range("B" & i + 1).Value = lastrowNewString '"i + 1" accounts for the Totals column in CountsByClinic
                
       Exit For
           End If
       Next j
Next i
End Sub

Move Column A to Column C

    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Data")
    ws.Columns("A:A").Cut
    ws.Columns("D:D").Insert 'note you have to paste one extra row to the right!
'    ws.Columns("A:A").Select
'    Selection.Cut
'    ws.Columns("C:C").Select
'    ws.Paste
'    ws.Range("C1").Select
End Sub

Delete Some Specific Sheets

Option Explicit
Sub deleteSomeSpecificSheets()
Dim ws As Worksheet
Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    For Each ws In Application.ActiveWorkbook.Worksheets
        If ws.Name = "Data" Or ws.Name = "instrxns" Or ws.Name = "Submit" Then
          ws.Delete
        End If
    Next
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub