Vba copy and paste

[mkshrestha]

I been struggling a lot on this issu.
i have sheet 1 where i column a i have some data like
Col A sheet 1 Column B
Status Count
Rejected 12
Accepted 13
Duplicate 14
No duplicate 15

In my second sheet i have simillar data
Column A Column B
Status Count
Rejected
Accepted
Duplicate
No duplicate

The order of the status in sheet 2 is same all the time but the order if the status of sheet 1 will change each time i get the new sheet. Now i need to copy the count from sheet 1 to sheet 2 based on status in sheet 2. I can only copy the data if the order of the status in sheet 1 and sheet 2 are same, the code below copies the data onyl if the status order in sheet 1 column A and sheet 2 column A is same.

   Sub cpy()
    Dim mystatus As String
    Dim i As Long
    Dim j As Long
    Dim lastrow As Long
    Dim lstrow As Long
    Dim nextcol As Long
    lastrow = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
  
    ' mystatus = Sheets("FL").Cells(i, "A").Value
 
          
              For i = 2 To lastrow
               mystatus = Sheets("FL").Cells(i, "A").Value
                 If Sheets("Sheet1").Cells(i, "A").Value = mystatus Then
                   nextcol = Sheets("FL").Cells(i, Columns.Count).End(xlToLeft).Column + 1
                 
               
                    Sheets("Sheet1").Cells(i, "B").Copy
                    Sheets("sheet2").Cells(i, nextcol).PasteSpecial
                End If
            
            
              Next i
   
End Sub

it doesn't copy the data if sheet 1 column A status is
Status
Accepted
Not Duplicate
Rejected
Duplicate

Please help, any suggesstion will be very very helpful..

 

[Hui]

Can you please attach your file with some sample data so we can better assess the issue

 

[Marc L]

​

Why VBA as an easy beginner formula does the job ? (VLOOKUP) And even via VBA you can directly use a formula …​

​

 

[mkshrestha]

Thank you so much for the responses, i would have used the vlook up , but i also have second creteria to full fill before it copies the data , the code needs to look for the status and also for the state name in the second row of each colunm to the right. If the row value is FL it copy and paste it to the FL tab, if the row value NJ then copy and paste it to the NJ tab, if the row value is TN then copy and paste it to TN tab.

please look for the attachment for cleat idea.



Thank you so very much, i really appericiated....

 

[dan_l]

This sounds a lot like a database task instead of a excel macro task.

 

[mkshrestha]

I am not sure, wheather its a Database task, but need to accomplish this taks using vba, i think sorting will resolve this issue,
I tried to run following code but its giving run time error
ActiveSheet.PivotTables(1).PivotFields("Row Labels").AutoSort xlAscending " Unable to get Pivot Fields of the pivot Tables. Please help

Thank you in Advance

 

[mkshrestha]

Can you please attach your file with some sample data so we can better assess the issue

I have attached excel file in my last post, please help

 

[Marc L]

​

The attachment is far away from your initial explanation so yo must revise your attachment​

or revise your explanation or move to some mind reader forum …​

​

 

[mkshrestha]

Hello every one
I have trying to fetch data from database using excel vba, and the database is SQL Server, i have the code working find, i need to get the user input for date range for the sql from the excel sheet cell vaule. I am am getting so many errors ,please help
Below is the VBA Script, thank you so much in advance

Option Explicit
Const connstring = "Provider=SQLNCLI11;Server=ERDBREP01,40014\SQL SERVER 12.0.6259;Database=ENCREP;Trusted_Connection=yes;"

Sub GetSqlData()
    'clear existing data
    ClearOldData
   
    'connect and query the database
    Dim con As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim cm As ADODB.Command
   
    Set con = New ADODB.Connection
    Set rs = New ADODB.Recordset
    'Set cm.ActiveConnection = con
   
       
    con.Open connstring
    con.CommandTimeout = 0
   
    'con.Execute , GetSqlString
    rs.Open GetSqlString, con
    'GetSqlString.Execute
   
    'load the data onto the sheet
    'Application.ThisWorkbook.
     'cm.CommandText = "WH.dbo.ourProcName"
     'cm.CommandTimeout = 120
    Sheets("Data").Activate
   
   ActiveSheet.Range("A4").CopyFromRecordset rs
    rs.Close
    con.Close
   
    'clean up the objects
    Set rs = Nothing
    Set con = Nothing
   
    MsgBox "ALL THE DATA ARE COPIED TO DATA SHEET"
   
End Sub

Private Sub ClearOldData()
    Range("A4").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.ClearContents
   Range("A4").Select
End Sub

Function GetSqlString() As String

Dim StartDate As Date, EndDate As Date
Dim MySql As String


'Startdate = Application.InputBox("Enter start date", Type:=Date)
'Startdate = InputBox("Insert date in format mm/dd/yyyy", "Date Range Validated:", Format(Now(), "mm/dd/yyyy"))
'Enddate = InputBox("Insert date in format mm/dd/yyyy", "Date Range Validated:", Format(Now(), "mm/dd/yyyy"))
'Enddate = Application.InputBox("Enter end date", Type:=Date)
   StartDate = ThisWorkbook.Sheets("Input").Cells(3, 2)
   EndDate = ThisWorkbook.Sheets("Input").Cells(5, 2)

MySql = "  SELECT COUNT(COLS.PATIENT_ACCOUNT_NUMBER) CLAIMCOUNT,COLS.OUTBOUND_REPORTING_ENTITY_KEY,COLS.LOB,  "
            MySql = MySql & "  CONVERT (DATE,OFH.SUBMIT_DATE_TIME) AS SUBMITTEDATE_TIME,OFH.FILE_NAME, CLM.SUBMITTER_IDENTIFIER AS TPID,  "
            MySql = MySql & "  LOB_CLAIM_TYPE = CASE WHEN  OFH.FILE_NAME LIKE  '%WMC_301414_P%' THEN 'WMC_PROFESSIONAL'  "
            MySql = MySql & "  WHEN  OFH.FILE_NAME LIKE  '%WMC_301414_I%' THEN 'WMC_INSTITUTIONAL'  "
            MySql = MySql & "  WHEN  OFH.FILE_NAME LIKE  '%WMC_301414_D%' THEN 'WMC_DENTAL'  "
            MySql = MySql & "  WHEN  OFH.FILE_NAME LIKE  '%WMC_301841_P%' THEN 'WMC_PROFESSIONAL'  "
            MySql = MySql & "  WHEN  OFH.FILE_NAME LIKE  '%WMC_301841_I%' THEN 'WMC_INSTITUTIONAL'  "
            MySql = MySql & "  WHEN  OFH.FILE_NAME LIKE  '%WMC_301841_D%' THEN 'WMC_DENTAL'  "
            MySql = MySql & "  WHEN  OFH.FILE_NAME LIKE  '%WMC_301842_I%' THEN 'WMC_INSTITUTIONAL'  "
            MySql = MySql & "  WHEN  OFH.FILE_NAME LIKE  '%WMC_301842_P%' THEN 'WMC_PROFESSIONAL'  "
            MySql = MySql & "  WHEN  OFH.FILE_NAME LIKE  '%WMC_301841_D%' THEN 'WMC_DENTALL'  "
            MySql = MySql & "  WHEN  OFH.FILE_NAME LIKE  '%WMC_301830_I%' THEN 'WMC_INSTITUTIONAL'  "
            MySql = MySql & "  WHEN  OFH.FILE_NAME LIKE  '%WMC_301830_P%' THEN 'WMC_PROFESSIONAL'  "
            MySql = MySql & "  WHEN  OFH.FILE_NAME LIKE  '%WMC_301830_D%' THEN 'WMC_DENTAL'  "
            MySql = MySql & "  WHEN  OFH.FILE_NAME LIKE  '%WMN_Title19_301993_P%' THEN 'WMN_TITLE19_PROFESSIONAL'  "
            MySql = MySql & "  WHEN  OFH.FILE_NAME LIKE  '%WMN_Title19_301993_I%' THEN 'WMN_TITLE19_INSTITUTIONAL'  "
            MySql = MySql & "  WHEN  OFH.FILE_NAME LIKE  '%WMN_Title19_301993_D%' THEN 'WMN_TITLE19_DENTAL'  "
            MySql = MySql & "  WHEN  OFH.FILE_NAME LIKE  '%WMN_Title21_301993_P%' THEN 'WMN_TITLE21_PROFESSIONAL'  "
            MySql = MySql & "  WHEN  OFH.FILE_NAME LIKE  '%WMN_Title21_301993_I%' THEN 'WMN_TITLE121_INSTITUTIONAL'  "
            MySql = MySql & "  WHEN  OFH.FILE_NAME LIKE  '%WMN_Title21_301993_D%' THEN 'WMN_TITLE121_DENTAL'  "
            MySql = MySql & "  Else 'NOTHING' END  "
            MySql = MySql & "  FROM ERSVC.CLAIM_OUTBOUND_LATEST_STATUS COLS  "
            MySql = MySql & "  JOIN  ERSVC.O_CLAIM CLM  "
            MySql = MySql & "  ON COLS.CLAIM_KEY = CLM.CLAIM_KEY "
            MySql = MySql & "  AND COLS.CLAIM_VERSION_KEY = CLM.CLAIM_VERSION_KEY "
            MySql = MySql & "  JOIN  ERSVC.OUTBOUND_FILE_DETAIL OFD  "
            MySql = MySql & "  ON COLS.PATIENT_ACCOUNT_NUMBER = OFD.PATIENT_ACCOUNT_NUMBER  "
            MySql = MySql & "  JOIN ERSVC.OUTBOUND_FILE_HEADER OFH  "
            MySql = MySql & "  ON OFD. OUTBOUND_FILE_HEADER_KEY = OFH.OUTBOUND_FILE_HEADER_KEY  "
            MySql = MySql & "  WHERE   COLS.LOB IN ('WMN', 'WMC')  "
            'MySql = MySql & "  AND OFH.SUBMIT_DATE_TIME > #" & Format(StartDate, "YYYY-MM-DD") & "#  "
           ' MySql = MySql & "  AND OFH.SUBMIT_DATE_TIME < #" & Format(EndDate, "YYYY-MM-DD") & "#  "
            'MySql = MySql & "  AND OFH.SUBMIT_DATE_TIME >  #" & StartDate""#  " '02/04/2019   '& Startdate &"
           ' MySql = MySql & "  AND OFH.SUBMIT_DATE_TIME < #""EndDate""#   " ' & Enddate &
            'MySql = MySql & "  AND OFH.SUBMIT_DATE_TIME BETWEEN  '02/04/2019' AND '07/30/2019'  "
             MySql = MySql & "  AND OFH.SUBMIT_DATE_TIME > " & ActiveWorkbook.Sheets("Input").Range("$B3").Value & " "
             MySql = MySql & "  AND OFH.SUBMIT_DATE_TIME < " & ActiveWorkbook.Sheets("Input").Range("$B4").Value & " "
             MySql = MySql & "  GROUP BY COLS.OUTBOUND_REPORTING_ENTITY_KEY,COLS.LOB, CLM.SUBMITTER_IDENTIFIER, OFH.SUBMIT_DATE_TIME , OFH.FILE_NAME   "
             MySql = MySql & "  ORDER BY SUBMIT_DATE_TIME   "
                              

GetSqlString = MySql

'Debug.Print MySql

End Function