Posts by Rmrekoj
-
-
Thanks so much sir
-
Hi sir,
if you don't mind can you please describe me the below thing... like how its works...dic(x(i, 1)) = Empty
-
too hard sir , salute ....
and thanks to make it macro -
after 6hrs continuous rnd I found this .... and its working fine
Sub test()
Dim dic As Object, a, v, i As Long, e
Dim b() As Varianta = Array("Apples", "Peaches", "Orange","",0)
Set dic = CreateObject("scripting.dictionary")
With ActiveSheet.UsedRange
v = Columns(2).Value
For i = 1 To UBound(v)
dic(v(i, 1)) = Empty
Next
For i = 0 To UBound(a)
If dic.exists(a(i)) Then dic.Remove a(i)
Next
ReDim b(1 To dic.Count)
For Each k In dic.keys
k = "" & k & ""
m = m + 1b(m) = k
Next k.AutoFilter field:=2, Criteria1:=b, Operator:=xlFilterValues
End With
End Sub
-
hi Alan will share you the attached with my work and output result
-
hi team,
thanks for helping me always..Hello why would the following using <> not work?
oWS.UsedRange.AutoFilter Field:=2, Criteria1:=Array("<>Apples","<>Peaches","<>Orange"), Operator:=xlFilterValues
is there any solution or optional loop
-
Hi Team,
I need your help to copy whole interior design of cells into vba code so that I can use as per my requirement ...
is it possible to do
-
This is the working which I have done with your help sir.. m just stuck over sorting of dic.key now
[tr]
[TABLE="border: 0, cellpadding: 0, cellspacing: 0, width: 775"]
[td]Sub Vmn()
[/td]
[/tr]
[tr]
[td][/td]
[/tr]
[tr]
[td]Dim col1, col2, i As Integer
[/td]
[/tr]
[tr]
[td]Dim y()
[/td]
[/tr]
[tr]
[td]Dim rng, c, myrange1, myrange2, sng, ar, kng, mng As Range
[/td]
[/tr]
[tr]
[td]Dim count As Long
[/td]
[/tr]
[tr]
[td]Dim dic As Object
[/td]
[/tr]
[tr]
[td]Dim book, mbook As Workbook
[/td]
[/tr]
[tr]
[td]Dim fn, pt, gn, d As String
[/td]
[/tr]
[tr]
[td][/td]
[/tr]
[tr]
[td]Application.ScreenUpdating = False
[/td]
[/tr]
[tr]
[td][/td]
[/tr]
[tr]
[td]Set mbook = ThisWorkbook
[/td]
[/tr]
[tr]
[td][/td]
[/tr]
[tr]
[td]pt = ThisWorkbook.Path & Application.PathSeparator
[/td]
[/tr]
[tr]
[td][/td]
[/tr]
[tr]
[td]fn = Dir(pt & "*.xls", vbNormal)
[/td]
[/tr]
[tr]
[td][/td]
[/tr]
[tr]
[td]Do Until fn = ""
[/td]
[/tr]
[tr]
[td][/td]
[/tr]
[tr]
[td][/td]
[/tr]
[tr]
[td]If fn <> ThisWorkbook.Name Then
[/td]
[/tr]
[tr]
[td][/td]
[/tr]
[tr]
[td]Set book = Workbooks.Open(Filename:=pt & fn)
[/td]
[/tr]
[tr]
[td][/td]
[/tr]
[tr]
[td][/td]
[/tr]
[tr]
[td]col1 = WorksheetFunction.Match("*Data1*", ActiveSheet.Range("1:1"), 0)
[/td]
[/tr]
[tr]
[td]col2 = WorksheetFunction.Match("*Data2*", ActiveSheet.Range("1:1"), 0)
[/td]
[/tr]
[tr]
[td][/td]
[/tr]
[tr]
[td]lr = ActiveSheet.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
[/td]
[/tr]
[tr]
[td][/td]
[/tr]
[tr]
[td]Set rng = ActiveSheet.Range(Cells(2, col1), Cells(lr, col2))
[/td]
[/tr]
[tr]
[td][/td]
[/tr]
[tr]
[td]Set dic = CreateObject("scripting.dictionary")
[/td]
[/tr]
[tr]
[td][/td]
[/tr]
[tr]
[td]For Each c In rng
[/td]
[/tr]
[tr]
[td][/td]
[/tr]
[tr]
[td]dic(c.Value) = c.Value
[/td]
[/tr]
[tr]
[td][/td]
[/tr]
[tr]
[td]Next
[/td]
[/tr]
[tr]
[td][/td]
[/tr]
[tr]
[td]Set myrange1 = ActiveSheet.Range(Cells(2, col1), Cells(lr, col1)).SpecialCells(xlCellTypeVisible)
[/td]
[/tr]
[tr]
[td]Set myrange2 = ActiveSheet.Range(Cells(2, col2), Cells(lr, col2)).SpecialCells(xlCellTypeVisible)
[/td]
[/tr]
[tr]
[td][/td]
[/tr]
[tr]
[td]If book.Name Like "*1st*" Then
[/td]
[/tr]
[tr]
[td][/td]
[/tr]
[tr]
[td]d = "B19"
[/td]
[/tr]
[tr]
[td]ElseIf book.Name Like "*2nd*" Then
[/td]
[/tr]
[tr]
[td][/td]
[/tr]
[tr]
[td]d = "B32"
[/td]
[/tr]
[tr]
[td]ElseIf book.Name Like "*3rd*" Then
[/td]
[/tr]
[tr]
[td][/td]
[/tr]
[tr]
[td]d = "B41"
[/td]
[/tr]
[tr]
[td]ElseIf book.Name Like "*4th*" Then
[/td]
[/tr]
[tr]
[td][/td]
[/tr]
[tr]
[td]d = "B46"
[/td]
[/tr]
[tr]
[td]Else
[/td]
[/tr]
[tr]
[td]End If
[/td]
[/tr]
[tr]
[td][/td]
[/tr]
[tr]
[td][/td]
[/tr]
[tr]
[td]mbook.Sheets("sheet1").Range(d).Resize(dic.count) = Application.Transpose(dic.Keys)
[/td]
[/tr]
[tr]
[td][/td]
[/tr]
[tr]
[td]Set kng = mbook.Sheets("sheet1").Range(d, mbook.Sheets("sheet1").Range(d).End(xlDown))
[/td]
[/tr]
[tr]
[td][/td]
[/tr]
[tr]
[td][/td]
[/tr]
[tr]
[td]For Each sng In kng
[/td]
[/tr]
[tr]
[td]For Each ar In myrange1
[/td]
[/tr]
[tr]
[td]count = count + Application.WorksheetFunction.CountIf(ar, sng)
[/td]
[/tr]
[tr]
[td]Next ar
[/td]
[/tr]
[tr]
[td][/td]
[/tr]
[tr]
[td]i = i + 1
[/td]
[/tr]
[tr]
[td][/td]
[/tr]
[tr]
[td]ReDim Preserve y(1 To 2, 1 To i)
[/td]
[/tr]
[tr]
[td][/td]
[/tr]
[tr]
[td]y(1, i) = count
[/td]
[/tr]
[tr]
[td][/td]
[/tr]
[tr]
[td]count = 0
[/td]
[/tr]
[tr]
[td]Next sng
[/td]
[/tr]
[tr]
[td][/td]
[/tr]
[tr]
[td]i = 0
[/td]
[/tr]
[tr]
[td]For Each sng In kng
[/td]
[/tr]
[tr]
[td]For Each ar In myrange2
[/td]
[/tr]
[tr]
[td]count = count + Application.WorksheetFunction.CountIf(ar, sng)
[/td]
[/tr]
[tr]
[td]Next ar
[/td]
[/tr]
[tr]
[td][/td]
[/tr]
[tr]
[td]i = i + 1
[/td]
[/tr]
[tr]
[td]y(2, i) = count
[/td]
[/tr]
[tr]
[td][/td]
[/tr]
[tr]
[td][/td]
[/tr]
[tr]
[td][/td]
[/tr]
[tr]
[td]count = 0
[/td]
[/tr]
[tr]
[td]Next sng
[/td]
[/tr]
[tr]
[td][/td]
[/tr]
[tr]
[td][/td]
[/tr]
[tr]
[td]book.Close False
[/td]
[/tr]
[tr]
[td][/td]
[/tr]
[tr]
[td]mbook.Sheets("sheet1").Range(d).Offset(0, 1).Resize(i, 2) = Application.Transpose(y)
[/td]
[/tr]
[tr]
[td]i = 0
[/td]
[/tr]
[tr]
[td]End If
[/td]
[/tr]
[tr]
[td][/td]
[/tr]
[tr]
[td]fn = Dir()
[/td]
[/tr]
[tr]
[td][/td]
[/tr]
[tr]
[td]Application.ScreenUpdating = False
[/td]
[/tr]
[tr]
[td][/td]
[/tr]
[tr]
[td]Loop
[/td]
[/tr]
[tr]
[td][/td]
[/tr]
[tr]
[td][/td]
[/tr]
[tr]
[td]End Sub
[/td]
[/tr]
[/TABLE] -
Should be not use dictionary
Codesub test() dim r as range with CreateObject("System.Collections.Arraylist") for each r in columns(1).specialcells(2).cells .add cstr(r.value) next r .sort [b1].resize(.count) = application.Transpose(.toarray) end with end sub### with CreateObject("System.Collections.ArrayList") ## because of space between collections. Arraylist
it s working fine sir.. but I want unique value only.. as I have duplicates values
-
Hi Sir,
while run the above macro showing below error .. can you please help what is the reason..
Run Time Error '429'
ActiveX Component can't create object. -
Hi Team,
Set dic = CreateObject("scripting.dictionary")
For Each c In rng
dic(c.Value) = c.Value
Next
"""" need to sort each dic value in alphabetically then do below process###
Range("E2").Resize(dic.count) = Application.Transpose(dic.Keys)
Thanks so much
-
.Range("B28").Resize(dic.count) = Application.Transpose(dic.Keys)
can I change range for this each time each workbook .... from B28 to
like belowB28
B47
B98
B112
this is the question
-
-
Hello Mr. Graha_karya can u check once again the above code as it was working fine previously but now showing "out of range error"... what will be the issue ?
-
ohh woooow ... nice sir... thanks so much ...
I think u had phd in unbound, arrays, ... you always solved the questions by unpredicted way...
-
Hi Team,
I got the solution....:hyper2:
Sub panda()
Dim Myarr As Variant
Dim i As Variant
Dim j As Integer
Dim k As Integer
Myarr = Array(1, 5, 10, 15, 53, 58, 63, 68, 73)For Each i In Myarr
For j = 1 To 5If j <> 3 Then
k = k + 1
Cells(i, j).Value = "count" & k
End If
Next j
Next iEnd Sub
-
this is the exiting right now m using which , I have to specify each cell each value ...
that's why need loop ,
you will understand what I need actually.. [TABLE="border: 0, cellpadding: 0, cellspacing: 0, width: 205"]
[tr]
[td]ActiveCell.Offset(0, 0) = count1
[/td]
[/tr]
[tr]
[td]ActiveCell.Offset(0, 1) = count2
[/td]
[/tr]
[tr]
[td]ActiveCell.Offset(0, 3) = count3
[/td]
[/tr]
[tr]
[td]ActiveCell.Offset(0, 4) = count4
[/td]
[/tr]
[tr]
[td]ActiveCell.Offset(5, 0) = count5
[/td]
[/tr]
[tr]
[td]ActiveCell.Offset(5, 1) = count6
[/td]
[/tr]
[tr]
[td]ActiveCell.Offset(5, 3) = count7
[/td]
[/tr]
[tr]
[td]ActiveCell.Offset(5, 4) = count8
[/td]
[/tr]
[tr]
[td]ActiveCell.Offset(10, 0) = count9
[/td]
[/tr]
[tr]
[td]ActiveCell.Offset(10, 1) = count10
[/td]
[/tr]
[tr]
[td]ActiveCell.Offset(10, 3) = count11
[/td]
[/tr]
[tr]
[td]ActiveCell.Offset(10, 4) = count12
[/td]
[/tr]
[tr]
[td]ActiveCell.Offset(15, 0) = count13
[/td]
[/tr]
[tr]
[td]ActiveCell.Offset(15, 1) = count14
[/td]
[/tr]
[tr]
[td]ActiveCell.Offset(15, 3) = count15
[/td]
[/tr]
[tr]
[td]ActiveCell.Offset(15, 4) = count16
[/td]
[/tr]
[tr]
[td]ActiveCell.Offset(53, 0) = count17
[/td]
[/tr]
[tr]
[td]ActiveCell.Offset(53, 1) = count18
[/td]
[/tr]
[tr]
[td]ActiveCell.Offset(53, 3) = count19
[/td]
[/tr]
[tr]
[td]ActiveCell.Offset(53, 4) = count20
[/td]
[/tr]
[tr]
[td]ActiveCell.Offset(58, 0) = count21
[/td]
[/tr]
[tr]
[td]ActiveCell.Offset(58, 1) = count22
[/td]
[/tr]
[tr]
[td]ActiveCell.Offset(58, 3) = count23
[/td]
[/tr]
[tr]
[td]ActiveCell.Offset(58, 4) = count24
[/td]
[/tr]
[tr]
[td]ActiveCell.Offset(63, 0) = count25
[/td]
[/tr]
[tr]
[td]ActiveCell.Offset(63, 1) = count26
[/td]
[/tr]
[tr]
[td]ActiveCell.Offset(63, 3) = count27
[/td]
[/tr]
[tr]
[td]ActiveCell.Offset(63, 4) = count28
[/td]
[/tr]
[tr]
[td]ActiveCell.Offset(68, 0) = count29
[/td]
[/tr]
[tr]
[td]ActiveCell.Offset(68, 1) = count30
[/td]
[/tr]
[tr]
[td]ActiveCell.Offset(68, 3) = count31
[/td]
[/tr]
[tr]
[td]ActiveCell.Offset(68, 4) = count32
[/td]
[/tr]
[tr]
[td]ActiveCell.Offset(73, 0) = count33
[/td]
[/tr]
[tr]
[td]ActiveCell.Offset(73, 1) = count34
[/td]
[/tr]
[tr]
[td]ActiveCell.Offset(73, 3) = count35
[/td]
[/tr]
[tr]
[td]ActiveCell.Offset(73, 4) = count36
[/td]
[/tr]
[/TABLE] -
Hi team,
I want to use the each cell value stored in variable (which comes from autofilter count)
Sub panda()
Dim Myarr As Variant
Dim i As Variant
Dim j As Integer
Myarr = Array(1, 5, 10, 15, 53, 58, 63, 68, 73)For Each i In Myarr
For j = 1 To 5If j <> 3 Then
Cells(i, j).Value = [SIZE=14px]"count" & j[/SIZE]
End If
Next j
Next iEnd Sub
above is the sub I have a variables which is stored a specific value and I need to use that variable in above sub
count1, count2, count3 . .. . . . . . .till count36
how will I get the each cell value like " count1, count2, count3 . .. . . . . . .till count36 "
really thanks full for the every help and support
-
Hi Sir,
thanks so much its working fine... :tabasco::congrats::congrats:
