Posts by Krishnakumar
-
-
-
-
-
Re: Extract specific number from txt file
You need to adjust those lines where I made comments.
Or please post couple of text files and the excel file.
-
Re: Extract specific number from txt file
Adjust the variable settings and comments accordingly.
[vb]Option Explicit
Sub kTest()
Dim k, kk, i As Long, fn As String, Flg As Boolean
Dim Fldr As String, j As Long, wks As Worksheet
Fldr = "C:\Test" '<<< adjust this text file path
Const EndsWith As String = "BBB" 'case sensitive. In the file there is a parenthesis after BBB. It should not be there or add the parenthesis in the variable
If Not Right(Fldr, 1) = Application.PathSeparator Then Fldr = Fldr & Application.PathSeparator
Set wks = Worksheets("Sheet1") '<<< adjust the sheet name
k = wks.Range("a1").CurrentRegion.Resize(, 3).Value '<<< assume data starts from A1:Cx, where A1:C1 holds headers
For i = 2 To UBound(k, 1)
fn = Dir(Fldr & "*" & k(i, 1) & "*.txt")
If Len(fn) Then
kk = Split(CreateObject("scripting.filesystemobject").opentextfile(Fldr & fn).readall, vbNewLine)
Flg = False
For j = 0 To UBound(kk)
If Trim(kk(j)) Like ("*" & EndsWith) Then
Flg = True
End If
If Flg Then
If kk(j) Like "Total Number of*" Then '<<< % value
k(i, 3) = Val(Split(kk(j), "=")(1)) 'splitting the line using the delimiter '='. hope '=' will always be there
Exit For
End If
End If
Next
End If
Next
wks.Range("a1").CurrentRegion.Resize(, 3).Value = k
End Sub[/vb] -
Re: Need help to summarize - 20$
Your code is ready. Please make the payment and upon receiving the fee, will post the workbook here.
-
Re: Need help to summarize - 20$
Would it work by this time tomorrow? Also can you provide the expected outlet?
-
Re: Need help to summarize - 20$
If you need this today itself, open to other developers. Otherwise, I can take this up.
-
Re: Need help to summarize - 20$
I can look at this for you.
-
Re: Selecting first 10 rows of filtered data
Try this
[vb]Option Explicit
Sub kTest()
Dim Data As Range
Dim CopyRng As Range
Dim r As Long
With Worksheets("Data Dump")
r = .Range("a" & .Rows.Count).End(3).Row
Set Data = .Range("a8:h" & r)
End With
With Data
.AutoFilter Field:=8, Criteria1:="10", Operator:=xlTop10Items
Set CopyRng = .Offset(1, 1).Resize(.Rows.Count, .Columns.Count - 1).SpecialCells(12)
If Not CopyRng Is Nothing Then
CopyRng.Copy Worksheets("Top 10 Enquiries").Range("c3")
End If
End With
End Sub[/vb] -
Re: Dynamic range inside an array
It would work as long as [vb]Range("Current_Week").Value[/vb] returns a number. BTW, what's the error you got ?
-
Re: Extract Random Sample of 1% for each item in colum A of Sheet 1 to Sheet 2
Hi
try this
[vb]Option Explicit
Sub kTest()
Dim k, kk, kkk(), dic As Object, i As Long, t
Dim r As Long, j As Long, n As Long, p As Long
Set dic = CreateObject("scripting.dictionary")
dic.comparemode = 1
With Worksheets("Sheet1")
k = .Range("a1").CurrentRegion.Value2
End With
For i = 2 To UBound(k, 1)
If Len(k(i, 1)) Then
t = dic.Item(k(i, 1))
If IsEmpty(t) Then
dic.Item(k(i, 1)) = Array(1, i)
Else
t(0) = t(0) + 1
t(1) = t(1) & "|" & i
dic.Item(k(i, 1)) = t
End If
End If
Next
kk = Array(dic.keys, dic.items)
ReDim kkk(1 To UBound(k, 1), 1 To UBound(k, 2))
For i = 0 To UBound(kk(0))
p = kk(1)(i)(0) * 0.01
t = Split(kk(1)(i)(1), "|")
dic.RemoveAll
j = 1
Do While j <= p
r = Application.WorksheetFunction.RandBetween(1, UBound(t) + 1) - 1
If Not dic.exists(r) Then
dic.Item(r) = Empty
n = n + 1
kkk(n, 1) = k(t(r), 1)
kkk(n, 2) = k(t(r), 2)
j = j + 1
End If
Loop
Next
If n Then
With Worksheets("Sheet2")
.[a1].CurrentRegion.Offset(1).ClearContents
.[a2].Resize(n, 2).Value = kkk
End With
End If
End Sub[/vb] -
Re: VBA code to store values in a range and then sum ranges stored in memory
Hi Welcome to board !!!
there may be better ways....
[vb]Sub kTest()
Dim i As Long
Dim n As Long
Dim j As Long
Dim CF As Variant
Dim CFs() As Double
n = 3
CF = Range("cfs").Value
ReDim CFs(1 To n, 1 To UBound(CF, 2))
For i = 1 To n
Range("var") = i
For j = 1 To UBound(CF, 2)
CFs(i, j) = CF(1, j)
Next
Next
For i = 1 To UBound(CFs, 2)
Range("output").Cells(1, i).Value = Application.Sum(Application.Index(CFs, 0, i))
Next
End Sub[/vb] -
-
Re: format shapes depending on linked cells.
Hi
Welcome to board !!!
Does the attachment help you ?
-
Re: Sum all sheet based on column header
In C3 and copied down,
=SUMPRODUCT(SUMIF(INDIRECT("'"&$H$2:$H$4&"'!$B2:$M2"),$B$2,INDIRECT("'"&$H$2:$H$4&"'!$B"&ROWS($C$2:C2)+2&":m"&ROWS($C$2:C2)+2)))
where H2:H4 holds the sheet names
-
-
-