My first question here after many years as observer.
I am facing a problem in VBA. I am kind of noob - self-learner and this is a bit over my capabilities.
I have an Excel workbook with almost 100k rows. Here are some example of content (labels changed, only useful col):
Col A: LOT (Can be ABC or DEF)
Col B: Name
Col C: Value
Col D: Data
What I wish to do is for only DEF (Col A) and Value X99 (Col C), have a sample of 5 Names (Col B) with all rows of these names. Col B, you have a name which can have many Data - so for the same name you can have X rows.
I also want an exeption, it is that for each names having over 20 lines, I do not want to have them in my selection.
The goal is then to take the values and paste them in another workbook.
Here is a code I have been using for another random selection in this workbook. (Sorry the code is not nice att all as I am beginner)
Dim SQLr, ABC, DEF, RNDsh As Worksheet
Dim lastrow As Long
Dim i As Long
Dim d, n As Date
Dim searchfor As String
Dim Rng As Range
Dim MyRows() As Integer
Dim numRows, rndRows, nxtRow, nxtRnd, chkRnd, copyRow As Integer
'°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°° Checking 11, DEF
DEF.Activate
Range("A130").FormulaR1C1 = "11. SEPA DIRECT DEBIT"
Range("A130").Select
With Selection.Font
.Name = "Arial"
End With
Selection.Font.Bold = True
SQLr.Select
SQLr.ListObjects("SQL_table").Range.AutoFilter Field:=1, Criteria1:="DEF"
SQLr.ListObjects("SQL_table").Range.AutoFilter Field:=12, Criteria1:="=*X90*", Operator:=xlAnd
On Error Resume Next
Set Rng = Range("SQL_table").SpecialCells(xlCellTypeVisible)
On Error GoTo 0
'Copy filtered data to "RNDsh"
If Not Rng Is Nothing Then
Rng.Copy
RNDsh.Select
Range("A1").Select
ActiveSheet.Paste
ActiveCell.Columns("A:A").EntireColumn.EntireColumn.AutoFit
Randomize 'Initialize Random number seed and process the selection (sampling)
numRows = Sheets("RNDsh").Range("A" & Rows.Count).End(xlUp).Row
If numRows > 5 Then
rndRows = 5 'Get a selection of 5 rows (sample)
ReDim MyRows(rndRows)
For nxtRow = 1 To rndRows
getNew:
nxtRnd = Int((numRows) * Rnd + 1)
`chkRnd = 1 To nxtRow 'Loop through array, checking for Duplicates
If MyRows(chkRnd) = nxtRnd Then GoTo getNew 'Get new number if Duplicate is found
Next
MyRows(nxtRow) = nxtRnd 'Add element if Random number is unique
Next
'Loop through Array, copying rows to DEF
For copyRow = 1 To rndRows
RNDsh.Rows(MyRows(copyRow)).EntireRow.Copy Destination:=Sheets("LPB").Cells(130 + copyRow, 1)
DEF.Cells(130 + copyRow, 1).AddComment
DEF.Cells(130 + copyRow, 1).Comment.Visible = False
DEF.Cells(130 + copyRow, 1).Comment.Text Text:="Automatic Random - Macro."
Next
ElseIf numRows < 5 Then
Application.CutCopyMode = False
Selection.Cut
Sheets("DEF").Select
Rows("131:131").Select
Selection.Insert Shift:=xlDown
End If
'Clean RNDsh sheet
RNDsh.Select
Cells.Select
Selection.Delete Shift:=xlUp
ElseIf Rng Is Nothing Then LPB.Range("F130").FormulaR1C1 = "NO SEPA DIRECT DEBIT: PLEASE CHECK"
End If`
Actually, for the random selection I have been previously doing, I created a sheet "RNDsh" where I pasted the filtered data (with 2 criterias) from the first sheet.
Thank you for your help :-)
Aucun commentaire:
Enregistrer un commentaire