Posts by Rmrekoj

Rmrekoj · Nov 28th 2022

Thanks a lot. understood now

Rmrekoj · Nov 27th 2022

Thank you, sir. Would you please elaborate on the code.

Rmrekoj · Nov 26th 2022

Dear Team,

Please assist me in resolving the Subscript Out of range in Dynamic Range when Reclaiming Row .

i just store first value and at second getting error.

Code

            ReDim Preserve da(d, 4)

Code

Option Explicit

Sub Reco()

Dim a, ca(), da(), Nac(), Nad(), Gl(), Dt() As Variant
Dim i  As Integer
Dim c, d As Integer

a = Sheet1.Range("A1").CurrentRegion

d = 1
c = 1

 For i = LBound(a, 1) To UBound(a, 1)
    If IsNumeric(a(i, 9)) = True And a(i, 9) > 0 Then
        If IsEmpty(a(i, 4)) = False Then
            ReDim Preserve ca(c, 4)
                ca(c, 1) = Abs(a(i, 4))
                ca(c, 2) = a(i, 2)
                ca(c, 3) = a(i, 1)
                ca(c, 4) = a(i, 9)
        ElseIf IsEmpty(a(i, 5)) = False Then
         
            ReDim Preserve da(d, 4)
                da(d, 1) = Abs(a(i, 5))
                da(d, 2) = a(i, 2)
                da(d, 3) = a(i, 1)
                da(d, 4) = a(i, 9)
            d = 1 + d
        Else: MsgBox "Error"
        
        End If
Else: End If
Next i


End Sub

Display More

Thanks

Rmrekoj · Oct 24th 2022

Thank you, however this isn't really what I wanted.

Output should be Name-A, Name-B, Name-C, and Name-D, and more work is being done on the code using this to produce numerous excel files with specified requirements.

If you update the shared vba code, I will be overjoyed.

Rmrekoj · Oct 24th 2022

Dear Team,

I need your assistance to obtain the unique values with further names; an excel file with the outcome is also attached.

Thanks

Code

Sub GetUniques()

Dim d, e As Object, c As Variant, i As Long, lr As Long

Set d = CreateObject("Scripting.Dictionary")
Set e = CreateObject("Scripting.Dictionary")

lr = Cells(Rows.Count, 1).End(xlUp).row
c = Range("A2:B" & lr)
For i = 1 To UBound(c, 1)
    d(c(i, 1)) = 1
     e(c(i, 2)) = 1
    
Next i
Range("J2").Resize(d.Count) = Application.Transpose(d.keys)
Range("K2").Resize(e.Count) = Application.Transpose(e.keys)

End Sub

Display More

Rmrekoj · Sep 18th 2022

Oh thanks 👍

Rmrekoj · Sep 18th 2022

Thank you for your response,,,

However, it does not function.

getting below remark
#VALUE!

Rmrekoj · Sep 17th 2022

Finally resolved- this is all I wanted.
Thanks for your support

I need some last advice on how to get the red font. If there are no matching records, "Not Found" should appear in red font.

ClientMatch = "Not Found"

ClientMatch.Interior.Color = vbRed

Rmrekoj · Sep 15th 2022

SUB () has been created to get the data from sharedrive to a local excel file - and then the function executes the most recent/updated value

I have to run SUB() each time for most recent/updated data-

so I want that sub() should connect in that function ( with RS) so that it will directly link to sharedriver rather than local data

Rmrekoj · Sep 14th 2022

Oh, I get your viewpoint here; since it has already been made, there is no need for a new one, right?

Could you kindly connect that sub () here to the function? and complete it please??

With rs

Thanks very much

Rmrekoj · Sep 14th 2022

Dear Rory,

Sorry about that - could not well describe it

In the next line, I intend to link the data of the recordset so that when I run the function or utilise it, it will execute with the most recent version straight from the server database.

Set rs = newADODB.Recordset
With rs ''Getting error here now

Instead of utilising the sub "GetDataFromSource," I'd want to link it in the preceding line.

#attached the file for your ref

Code

Function ClientMatch(x As String, y As String)
Const StartRow = 2
Dim EndRow As Long
Dim iRow As Long
Dim k As Integer
Dim m As LongLong
Dim WB As Workbook
Dim WS As Worksheet
Application.ScreenUpdating = False

If InStr(1, y, "|") > 0 Or InStr(1, y, "/") > 0 Then
k = InStr(1, y, "|") Or InStr(1, y, "/")
m = Left(y, k - 1)
Else
m = y
End If

With Worksheets("Database")
EndRow = .UsedRange.Rows(.UsedRange.Rows.Count).Row
For iRow = StartRow To EndRow
If Trim(.Range("B" & iRow).Value) = Trim(x) And .Range("F" & iRow).Value = m Then
ClientMatch = .Range("A" & iRow).Value
Exit Function
End If
Next iRow
End With
ClientMatch = "Notfound"
End Function

Display More

Code

Sub GetDataFromSource()

    Dim cn As ADODB.Connection
    
    Set cn = New ADODB.Connection

    Dim rs As ADODB.Recordset
    
    cn.ConnectionString = _
        "Provider = Microsoft.ACE.OLEDB.12.0;" & _
        "Data Source=T:\OUPUT\;" & _
        "Extended Properties=""text;HDR=YES;"""
        
    cn.Open
    
    Set rs = New ADODB.Recordset
    rs.ActiveConnection = cn
    rs.Source = "SELECT * FROM [DataBase.CSV]"
    rs.Open
    Sheet2.Rows("2:" & Rows.Count).ClearContents
    Sheet2.Range("A2").CopyFromRecordset rs
    
    
    rs.Close
    cn.Close
Application.CalculateFullRebuild

End Sub

Display More

Rmrekoj · Sep 14th 2022

Mr. Rory,

Thanks for your response.

I had created a database sheet in the same file as "database" which is being used to run the function, and it was working fine, but instead of copying and pasting the data again and again, there is a real database saved on the server that is regularly updated, so I wanted to use that server data directly in the function so that each time will have the updated records.

Here is the current backup code that I use to acquire the most recent and fresh data.

Instead, I expected to have a direct access to the server's CSV file for the function.

Code

Sub GetDataFromSource()

    Dim cn As ADODB.Connection
    
    Set cn = New ADODB.Connection

    Dim rs As ADODB.Recordset
    
    cn.ConnectionString = _
        "Provider = Microsoft.ACE.OLEDB.12.0;" & _
        "Data Source=T:\OUPUT\;" & _
        "Extended Properties=""text;HDR=YES;"""
    
    cn.Open
    
    Set rs = New ADODB.Recordset
    rs.ActiveConnection = cn
    rs.Source = "SELECT * FROM [MainDatabase.CSV]"
    rs.Open
    Sheet2.Rows("2:" & Rows.Count).ClearContents
    Sheet2.Range("A2").CopyFromRecordset rs
    
    rs.Close
    cn.Close
Application.CalculateFullRebuild

End Sub

Display More

Thank you very much.

Rmrekoj · Sep 10th 2022

Team , need your help to fix the error @ with rs

Rmrekoj · Sep 9th 2022

Code

Function ClientMatch(x As String, y As String)
    Const StartRow = 2
    Dim EndRow As Long
    Dim iRow As Long
    Dim k As Integer
    Dim m As LongLong
    Dim WB As Workbook
    Dim WS As Worksheet
       
     
    Dim cn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Set cn = New ADODB.Connection
    
    cn.ConnectionString = _
        "Provider = Microsoft.ACE.OLEDB.12.0;" & _
        "Data Source=" & ThisWorkbook.Path & "\OUPUT\;" & _
        "Extended Properties=""text;HDR=YES;"""
        '"Extended Properties=""text;HDR=YES;FMT=Delimited;Imex=1;ImportMixedTypes=Text;"""
     
    Set rs = New ADODB.Recordset
    rs.ActiveConnection = cn
    rs.Source = "SELECT * FROM [CLIENT_DATA_OUT.CSV]"

        If InStr(1, y, "|") > 0 Or InStr(1, y, "/") > 0 Then
            k = InStr(1, y, "|") Or InStr(1, y, "/")
            m = Left(y, k - 1)
        Else
        m = y
        End If

     Set rs = newADODB.Recordset
     
    With rs ''Getting error here now
        EndRow = .UsedRange.Rows(.UsedRange.Rows.Count).Row
        For iRow = StartRow To EndRow
            If Trim(.Range("B" & iRow).Value) = Trim(x) And .Range("F" & iRow).Value = m Then
                ClientMatch = .Range("A" & iRow).Value
                Exit Function
            End If
        Next iRow
    End With
    ClientMatch = "Notfound"
End Function

Display More

Rmrekoj · Sep 9th 2022

Any chance to solve this?

Rmrekoj · Sep 8th 2022

Dear Team,

I have a database file that has whole data @attached from that data I simply want an output for that I have discovered a match function that is presently functioning with the same activesheet to extract it but I want to utilise it from the saved database

Code

Function EmpMatch(x As String, y As String)
    Const StartRow = 2
    Dim EndRow As Long
    Dim iRow As Long
    Dim k As Integer
    Dim m As LongLong
    
        'rootpath = "\'Share\NewData\Alberts\Database"        
        'afile = Dir(rootpath & "*.csv")
     
        If InStr(1, y, "|") > 0 Or InStr(1, y, "/") > 0 Then
            k = InStr(1, y, "|") Or InStr(1, y, "/")
            'y = Left(y, InStr(1, y, "|") Or InStr(1, y, "/") - 1)
            m = Left(y, k - 1)
        Else
        m = y
        End If

        'Z = InStr(1, Mystring, "|")
        'K = Left(x, NWword - 1)
        
     
    'With Worksheets("Database")
    With afile.Sheets("EmpDataBase")
        'EndRow = .Range("A:G").Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        EndRow = .UsedRange.Rows(.UsedRange.Rows.Count).Row
        For iRow = StartRow To EndRow
            If Trim(.Range("B" & iRow).Value) = Trim(x) And .Range("F" & iRow).Value = m Then
            'If .Range("B" & iRow).Value = x And .Range("F" & iRow).Value = y Then
                EmpMatch= .Range("A" & iRow).Value
                Exit Function
            End If
        Next iRow
    End With
    EmpMatch= "Notfound"
End Function

Display More

Please assist.

Rmrekoj · Nov 30th 2021

Thank you so much Sir, its really work fine with short data.

but getting stuck with 5,00,000 rows around 60+ MB data any other easy way

Rmrekoj · Nov 30th 2021

Hello.

Column "H" contain "D" or "DR" entire row should be deleted, in the excel i have shown the output which i need

Thanks

Rmrekoj · Nov 29th 2021

Hi,

Actually i want to delete rows which contain have specific (myown) value.

since the data is huge more than 5 lac rows there is for loop taking too much time for that i am sorting first and then from that specific value till end i could delete entire row by selecting it in range ( Range( Find value : Last Row)

here is the attachment for your reference.

Rmrekoj · Nov 29th 2021

Hi Team,

Request you to please suggest me how do i get this selection for delete entire row

Code

Firsfindvalue = Application.WorksheetFunction.Match("D*", Range("H2:H" & LastRow), 0) + 1
LastRow = Activesheet.Cells.SpecialCells(xlCellTypeLastCell).Row
Activesheet.Range("A & Firsfindvalue:A" & LastRow).Select

Regards,

Rm

Posts by Rmrekoj

ReDim Preserve - Subscript Out of Range

ReDim Preserve - Subscript Out of Range

ReDim Preserve - Subscript Out of Range

GetUniques from primary key only

GetUniques from primary key only

Extract data from a database file

Extract data from a database file

Extract data from a database file

Extract data from a database file

Extract data from a database file

Extract data from a database file

Extract data from a database file

Extract data from a database file

Extract data from a database file

Extract data from a database file

Extract data from a database file

Delete entire rows by range

Delete entire rows by range

Delete entire rows by range

Delete entire rows by range