Snasui Excel Forum

Code: Select all

Sub filterData()
Dim myvalue As String
On Error Resume Next
myvalue = InputBox("Enter the item you wish to extract")
Sheets(myvalue).Select
Sheets(myvalue).Cells.Clear
Range("A1") = "SUBMISSION_BATCH_NO"
Range("B1") = "POLICY_NO"
Range("C1") = "COMPANY_NAME"
Range("D1") = "NAME"
Range("E1") = "INCIDENT_DATE"
Range("F1") = "INCIDENT_TIME"
Range("G1") = "ADMIT_DATE"
Range("H1") = "DISCHARGE_DATE"
Range("I1") = "HOSPITAL_NAME"
Range("J1") = "ICD10"
Range("K1") = "COVERAGE_TYPE"
Range("L1") = "BILL_AMOUNT"
Range("M1") = "APPROVED_AMOUNT"
Range("N1") = "EXCESS_AMOUNT"
Range("O1") = "CLAIM_STATUS"
Range("P1") = "DECISION_DATE"
Range("Q1") = "PAYMENT_DATE"
Range("R1") = "DECLINE_REJECT_REASON"
Range("S1") = "CHANNEL_NAME"
Range("T1") = "PAYMENT_METHOD"
Range("U1") = "EMPLOYEE_CODE"
Range("V1") = "PLAN_CODE"
Range("W1") = "AGENT_CODE"
Range("X1") = "FULLNAME"
Range("Y1") = "PARENT_CODE"
Range("Z1") = "PARENT_NAME"
Range("AA1") = "UNIT_CODE"
Range("AB1") = "UNIT_NAME"
Range("AC1") = "OFFICE_CODE"
Range("AD1") = "OFFICE_NAME"
Range("AE1") = "DOCUMENT_CHANNEL"
Range("AF1") = "GOV_INSURANCE_FLAG"
Range("AG1") = "REMARK_CUSTOMER"
Range("AH1") = "ESUBMISSION_NO"
Range("A1:AH1").Font.Bold = True
Range("A1:AH1").Font.ColorIndex = 5

Sheets("Control Sheet(New)").Select
 Dim lastRow As Long
 lastRow = Sheets("Control Sheet(New)").Cells.Find(What:="*", _
After:=Range("A1"), _
LookAt:=xlPart, _
 LookIn:=xlFormulas, _
 SearchOrder:=xlByRows, _
 SearchDirection:=xlPrevious, _
 MatchCase:=False).Row

Dim lastColumn As Long
 lastColumn = Sheets("Control Sheet(New)").Cells.Find(What:="*", _
After:=Range("A1"), _
LookAt:=xlPart, _
 LookIn:=xlFormulas, _
 SearchOrder:=xlByColumns, _
 SearchDirection:=xlPrevious, _
 MatchCase:=False).Column

Sheets("Control Sheet(New)").Range(Cells(1, 1), Cells(lastRow, lastColumn)).AutoFilter Field:=23, Criteria1:=myvalue
 Sheets("Control Sheet(New)").Range(Cells(2, 1), Cells(lastRow, lastColumn)).SpecialCells(xlCellTypeVisible).Copy
 Sheets(myvalue).Select

erow = Sheets(myvalue).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row

Sheets(myvalue).Paste Destination:=Worksheets(myvalue).Rows(erow)
 Sheets("Control Sheet(New)").Select
 Sheets("Control Sheet(New)").Range(Cells(1, 1), Cells(lastRow, lastColumn)).AutoFilter Field:=23
 ActiveWorkbook.Save

 
End Sub

Code: Select all

Sub myLedger()

Dim lastRow As Long, i As Long, erow As Long

lastRow = Sheets("Control Sheet(New)").Range("A" & Rows.Count).End(xlUp).Row

For i = 2 To lastRow

If Sheets("Control Sheet(New)").Cells(i, 23) = "3000038" Then
 Sheets("Control Sheet(New)").Range(Cells(i, 1), Cells(i, 34)).Select
 Selection.Copy

'Sheets.Open ("Control Sheet(New)")
Sheets("3000038").Select
 lastRow = Sheets("3000038").Range("A" & Rows.Count).End(xlUp).Row

erow = lastRow + 1

ActiveSheet.Cells(erow, 1).Select
 ActiveSheet.Paste
 ActiveWorkbook.Save

Application.CutCopyMode = False
 End If
 Sheets("Control Sheet(New)").Select
 Next i
 End Sub

Code: Select all

Sub filterData()

Dim myvalue As String
myvalue = InputBox("Enter the item you wish to extract")
Sheets(myvalue).Select
Sheets(myvalue).Cells.Clear
Range("A1") = "SUBMISSION_BATCH_NO"
Range("B1") = "POLICY_NO"
Range("C1") = "COMPANY_NAME"
Range("D1") = "NAME"
Range("E1") = "INCIDENT_DATE"
Range("F1") = "INCIDENT_TIME"
Range("G1") = "ADMIT_DATE"
Range("H1") = "DISCHARGE_DATE"
Range("I1") = "HOSPITAL_NAME"
Range("J1") = "ICD10"
Range("K1") = "COVERAGE_TYPE"
Range("L1") = "BILL_AMOUNT"
Range("M1") = "APPROVED_AMOUNT"
Range("N1") = "EXCESS_AMOUNT"
Range("O1") = "CLAIM_STATUS"
Range("P1") = "DECISION_DATE"
Range("Q1") = "PAYMENT_DATE"
Range("R1") = "DECLINE_REJECT_REASON"
Range("S1") = "CHANNEL_NAME"
Range("T1") = "PAYMENT_METHOD"
Range("U1") = "EMPLOYEE_CODE"
Range("V1") = "PLAN_CODE"
Range("W1") = "AGENT_CODE"
Range("X1") = "FULLNAME"
Range("Y1") = "PARENT_CODE"
Range("Z1") = "PARENT_NAME"
Range("AA1") = "UNIT_CODE"
Range("AB1") = "UNIT_NAME"
Range("AC1") = "OFFICE_CODE"
Range("AD1") = "OFFICE_NAME"
Range("AE1") = "DOCUMENT_CHANNEL"
Range("AF1") = "GOV_INSURANCE_FLAG"
Range("AG1") = "REMARK_CUSTOMER"
Range("AH1") = "ESUBMISSION_NO"
Range("A1:AH1").Font.Bold = True
Range("A1:AH1").Font.ColorIndex = 5

Sheets("Control Sheet(New)").Select
 Dim lastRow As Long
 lastRow = Sheets("Control Sheet(New)").Cells.Find(What:="*", _
After:=Range("A1"), _
LookAt:=xlPart, _
 LookIn:=xlFormulas, _
 SearchOrder:=xlByRows, _
 SearchDirection:=xlPrevious, _
 MatchCase:=False).Row

Dim lastColumn As Long
 lastColumn = Sheets("Control Sheet(New)").Cells.Find(What:="*", _
After:=Range("A1"), _
LookAt:=xlPart, _
 LookIn:=xlFormulas, _
 SearchOrder:=xlByColumns, _
 SearchDirection:=xlPrevious, _
 MatchCase:=False).Column

Sheets("Control Sheet(New)").Range(Cells(1, 1), Cells(lastRow, lastColumn)).AutoFilter Field:=23, Criteria1:=myvalue
 Sheets("Control Sheet(New)").Range(Cells(2, 1), Cells(lastRow, lastColumn)).Copy
 Sheets(myvalue).Select

erow = Sheets(myvalue).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row

Sheets(myvalue).Paste Destination:=Worksheets(myvalue).Rows(erow)
 Sheets("Control Sheet(New)").Select
 Sheets("Control Sheet(New)").Range(Cells(1, 1), Cells(lastRow, lastColumn)).AutoFilter Field:=23
 ActiveWorkbook.Save

 
End Sub