Working with two worksheets

[LosingMyMindAgain]

Hello. I am fairly new to Excel macros and apologize ahead of time if this is a stupid question. I am looking to work with two sheets of a workbook. I found a macro that does what I want, but only when dealing with one sheet. Sheet1 is the data entry portion and Sheet2 is where the totals will be. With this macro I am hoping to cycle through Sheet1 Column N to distinguish the unique counties listed and then count the occurrences of each county. I'd then like to paste the unique counties on Sheet2 starting at E3. Then also paste the counts on Sheet2 starting at F3. How do I go about tweaking this so I can reference back and forth between the two sheets? Any tips would be greatly appreciated. Thank you!

Sub Special_Countif()
Dim i, LastRowA, LastRowB
'A=Data Column B=Unique Names C=Count
LastRowA = Range("A" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
Application.EnableEvents = False
Columns("B:C").ClearContents
For i = 1 To LastRowA
If Application.CountIf(Range("B:B"), Cells(i, "A")) = 0 Then
Cells(i, "B").Offset(1, 0).Value = Cells(i, "A").Value
End If
Next
Columns("B:B").Select
Selection.Sort Key1:=Range("B1"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
LastRowB = Range("B" & Rows.Count).End(xlUp).Row
For i = 2 To LastRowB
Cells(i, "C").Value = Application.CountIf(Range("A:A"), Cells(i, "B"))
Next i
Range("B1").Value = "Entry"
Range("C1").Value = "Occurrences"
Range("B1:C1").HorizontalAlignment = xlCenter
Range("B1").Select
Columns("B:C").AutoFit
Application.EnableEvents = True
End Sub

 

[hiker95]

LosingMyMindAgain,

Thanks for the new workbook.

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Sub GetUniqueCounts_PA()
' hiker95, 10/15/2014, ME807082
Dim w1 As Worksheet, w2 As Worksheet
Dim lr1 As Long, lr2 As Long, n As Long
Dim rng As Range, c As Range
Application.ScreenUpdating = False
Set w1 = Sheets("Sheet1")
Set w2 = Sheets("Sheet2")
With w2
  lr2 = .Cells(Rows.Count, "I").End(xlUp).Row
  If lr2 > 2 Then .Range("H3:I" & lr2).ClearContents
End With
With w1
  .Activate
  lr1 = .Cells(Rows.Count, "O").End(xlUp).Row
  n = Application.CountIf(.Range("N2:N" & lr1), "")
  Set rng = .Range("N2:N" & lr1)
  With CreateObject("Scripting.Dictionary")
    .CompareMode = vbTextCompare
    For Each c In rng
      If c.Offset(, 1).Value = "PA" Then
        If Not .Exists(c.Value) Then
          .Add c.Value, 1
        Else
          .Item(c.Value) = .Item(c.Value) + 1
        End If
      End If
    Next
  w2.Range("H3").Resize(.Count, 2) = Application.Transpose(Array(.keys, .Items))
  End With
End With
With w2
  lr2 = .Cells(Rows.Count, "I").End(xlUp).Row
  .Range("H3:I" & lr2).Sort key1:=.Range("H3"), order1:=1
  If n > 0 Then
    .Cells(lr2, 8) = "Not Recorded"
  End If
  .Columns("H:I").AutoFit
  .Activate
End With
Application.ScreenUpdating = True
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm

Then run the GetUniqueCounts_PA macro.