I am creating an array by selecting data from a MySQL database, here is where i create the array:
Dim call_costs_data(10000, 5)
While reader.Read()
counter = counter + 1
call_costs_data(counter, 1) = reader.GetString(0)
call_costs_data(counter, 2) = reader.GetString(1)
call_costs_data(counter, 3) = reader.GetString(2)
call_costs_data(counter, 4) = reader.GetString(3)
call_costs_data(counter, 5) = reader.GetString(4)
End While
number = counter
i am doing this multiple times with different tables, so when i run my function the data is all in arrays rather than searching the database each time in my loop (inside the function)
i am currently searching the array using a For loop like this:
For p = 1 To number
If call_costs_data(p, 1) = "some_value" Then
'do something here
End If
Next
but because i do this for so many arrays inside my loop and there are so many records to loop through before the correct one is found, its taking a long time.
What is the best way to change this to search the arrays?
Related
We have an access database create a csv list in an access table for each userid that logs into a computer. The problem is that if a userid logs in multiple times on one computer, than the userid is duplicated.
SO let's say this is what the table structure looks like
computer DailyUsers
ABC-123 ml12, rs12, ml12, ml12, ee13
DEF-456 zx44, aa33, zx44
And this is what I want a query to return
Computer DailyUsers
ABC-123 ml12, rs12, ee13
DEF-456 zx44, aa33
I tried using both Group By and Distinct but that looks on a row by row basis, not a field basis
How can this be achieved in Access 2013?
You can create a custom function in VBA to return only the unique users.
Add this in a VBA module:
Option Compare Database
Option Explicit
Public Function DistinctOnly(txt As String)
Dim arr, v, rv As String
Dim d As Object
arr = Split(txt, ",")
If UBound(arr) > 0 Then
Set d = CreateObject("scripting.dictionary")
For Each v In arr
d(Trim(v)) = 1
Next v
rv = Join(d.keys, ",")
Else
rv = txt
End If
DistinctOnly = rv
End Function
Usage:
SELECT Table1.[ID], Table1.[Users], DistinctOnly(Table1.[Users]) as UsersX
FROM Table1;
Input data and query results:
I am trying to import data to a table. Basically its a MCQs. All my questions are having superscripts and subscripts, for example X2 , and log52....
I have more than 2000 records, i have to import it. But after importing it comes in plain format, not taking powers. My DB is MYSQL (UTF-8)
Here is the example data
If log5 2, log5 (2x - 5) and log 5(2x - 7/2) are in AP , then x is equal to
after impoting it looks like above, but actually it should be
If log5 2, log5 (2x - 5) and log 5(2x - 7/2) are in AP , then x is equal to
Somebody plz suggest me how to do it
Here's a quick fix for the Subscripts:
Sub log_Script()
Dim cel As Range, rng As Range
Dim i&, k&
Dim myText$, findText$, curStr$
Set cel = Range("A1")
'myText = cel.Value
For i = 1 To Len(cel.Value)
k = k + 1
curStr = Mid(cel.Value, i, 1)
If curStr <> " " Then
findText = findText + curStr
ElseIf curStr = " " Then
findText = ""
End If
Debug.Print findText
If findText = "log" Then
If Mid(cel.Value, i + 1, 1) = " " Then
With cel.Characters(Start:=k + 2, Length:=1).Font
.Subscript = True
End With
Else
With cel.Characters(Start:=k + 1, Length:=1).Font
.Subscript = True
End With
End If
End If
Next i
End Sub
This will go through a range (set currently to be A1:A10), and for each cell, it'll look for log then take the next number and make it subscript. (Note: This is assuming all logs will have base < 10, let me know if that's not necessarily the case).
I could probably make this better, if you can post a few rows or cells from your CSV so I can see what the formatting is exacly like. (Or screenshot a part of your data, that 'd work too).
I have a field called 'Specimen' that has entries formatted like 'CM-Z-01', 'TOR-XY-03', etc. I want to populate 2 additional fields in the same table, called 'TestType' and 'Axis', with the first two sections of the 'Specimen' entry, respectively. So 'TestType' would have 'CM' and 'TOR'; Axis would have 'Z' and 'XY'
I can do the first one just fine, with
UPDATE MechanicalData
SET MechanicalData.TestType = Left(Specimen,InStr(Specimen,"-")-1);
Is there an easy way to grab the middle portion?
You can use the Split function which returns an array with the string parts:
firstPart = Split("TOR-XY-03", "-")(0)
secondPart = Split("TOR-XY-03", "-")(1)
Make a function that you can call in your query based on this function. You cannot use Split directly as it is not supported in SQL.
Public Function SpecimenPart(ByVal s As Variant, ByVal partNo As Long) As Variant
If Nz(s) <> "" Then
Dim parts As Variant
parts = Split(s, "-")
If partNo - 1 <= UBound(parts) Then
SpecimenPart = parts(partNo - 1)
End If
End If
End Function
The parameter partNo is one-based (1 for first part).
UPDATE MechanicalData SET
TestType = SpecimenPart(Specimen, 1),
Axis = SpecimenPart(Specimen, 2);
This problem is in an Excel .xls file.
Simplest Use Case:
Column A has one row.
Column B has 5 rows.
The 5 rows in Column B need to be merged into one row, delimited by newlines.
I have a huge .xls document where there are a ton of IDs in column A.
There are on average anywhere from 3 to 10 rows that belong to each column A row.
How to know which Column B rows belong to which Column A?
By the positioning of the cells.
One Column A row may have 5 Column B rows to the right of it.
I don't have any VBA experience.
I have looked around for macros and functions but haven't had any luck finding anything that matches this problem.
Edit:
I am now trying to figure out how to get the script to ignore rows that have a one-to-one mapping between column A and column B.
Edit again - 06-20-2012:
Now that I can attach images, here is a screenshot of an image for what I'm trying to get.
The rows for Brian and Mark should be ignored, while Scott and Tim get their values copied over.
Edit:
Unmerging column A, using the code that Andy supplied, and then using this VB script afterwards does the trick:
Sub mergeA()
For i = 2 To Cells(65535, 1).End(xlUp).Row
If IsEmpty(Cells(i, 1)) Then Range(Cells(i - 1, 1), Cells(i, 1)).Merge
Next
End Sub
That VB script puts the cells in column A back together
I didn't make the script, it came from this web page:
http://www.vbforums.com/showthread.php?t=601304
This will transform the data shown on the left to the output on the right:
Option Explicit
Sub Make_Severely_Denormalized()
Const HEADER_ROWS As Long = 1
Const OUTPUT_TO_COLUMN As Long = 3
Const DELIMITER As String = vbNewLine
Dim A_Range As Range
Dim B_Range As Range
Dim A_temp As Range
Dim B_temp As Range
Dim B_Cell As Range
Dim Concat As String
On Error GoTo Whoops
Set A_Range = Range("A1").Offset(HEADER_ROWS)
Do While Not A_Range Is Nothing
Set B_Range = A_Range.Offset(0, 1)
' some helper ranges
If A_Range.Offset(1, 0).Value = "" Then
Set A_temp = Range(A_Range, A_Range.End(xlDown).Offset(-1, 0))
Else
Set A_temp = A_Range.Offset(1, 0)
End If
Set B_temp = Range(B_Range, B_Range.End(xlDown)).Offset(0, -1)
' determine how high "B" is WRT no change in "A"
Set B_Range = Range(B_Range, B_Range.Resize( _
Application.Intersect(A_temp, B_temp, ActiveSheet.UsedRange).Count))
' loop through "B" and build up the string
Concat = ""
For Each B_Cell In B_Range
Concat = Concat & B_Cell.Value & DELIMITER
Next
Concat = Left(Concat, Len(Concat) - Len(DELIMITER))
' do the needful
A_Range.Offset(0, OUTPUT_TO_COLUMN - 1).Value = Concat
' find the next change in "A"
If A_Range.Offset(1, 0).Value = "" Then
Set A_Range = Application.Intersect(A_Range.End(xlDown), ActiveSheet.UsedRange)
Else
Set A_Range = A_Range.Offset(1, 0)
End If
Loop
Exit Sub
Whoops:
MsgBox (Err & " " & Error)
Stop
Resume Next
End Sub
I am trying to compare two recordsets. the first rs1 has random records. The second rs2 has the standard values for those records. Initially I am looking to take each of the records and see if they match with the standard set of values in the second recordset. There are four fields in each record set to be compared and all four must match.
I just need some help in the loop. I am trying to write the non matching records to an excel file.
Here is what I have so far
While Not rs1.EOF
With rs1
.MoveFirst
With rs2
.MoveFirst
While Not rs2.EOF
counter = counter + 1
a = 0
If rs1!Kk = rs2!Kk Then a = a + 1
If rs1!CC = rs2!CC Then a = a + 1
If rs1!HN = rs2!HN Then a = a + 1
If rs3!TN = rs2!TN Then a = a + 1
If a > 3 Then GoTo correct
.MoveNext
If rs2.EOF Then
If rs!Table_Name <> "table1" Then
i = i + 1
j = 1
counter = counter + 1
objSht.Cells(i, j).Value = "casenum" & rs1.Fields(1)
j = j + 1
stat_counter = stat_counter + 1
End If
If i = 65500 Then
Set wbexcel = objexcel.ActiveWorkbook
''//Set objSht = wbexcel.Worksheets("Sheet2")
Set objSht = wbexcel.Worksheets.Add
i = 2
End If
End If
correct:
rs1.MoveNext
Wend
End With
End With
Also any ideas on how i can segregate based on 2 of fields matching with standard and 3 of the fields matching with the standard values
Are the recordsets already sorted? I'm guessing that's the case since you move to the next rs2 on a non match. Personally i'd specify a sort to make 100% sure.
Also I'd test this pretty thoroughly with a small test dataset with a few edge cases to make sure you get what you expect.
With the above in mind your code looks like it'd work but i have a few small recommendations to make it easier to read.
First i'd recommend ditching the nested With rs1 and With rs2. Just refer to each recordset explicitly so you can clearly see what is happening to each rs. eg:
If a > 3 Then GoTo correct
.MoveNext
becomes
If a > 3 Then GoTo correct
rs2.MoveNext
Next your if statements with a = a + 1 could do with some tidying. eg:
If rs1!Kk = rs2!Kk and rs1!CC = rs2!CC and rs1!HN = rs2!HN and rs3!TN = rs2!TN then
''// Do Nothing or maybe increase a count or whatever :)
else
WriteToExcel(objSht , rs1.fields)
end if
You'll need to write a function called WriteToExcel() but this will make the next step easier. I think you want to write to different sheets depending on the matches?
If rs1!Kk = rs2!Kk and rs1!CC = rs2!CC and rs1!HN = rs2!HN and rs3!TN = rs2!TN then
''// Do Nothing
else if rs1!Kk = rs2!Kk and rs1!CC = rs2!CC and rs1!HN = rs2!HN then
WriteToExcel(objSht2 , rs1.fields)
else
WriteToExcel(objSht , rs1.fields)
end if
You may also want to look at switches in the case where you need any two matches, rather than specific matches as above... oh and variable j seems a bit superfluous.
My gut says you are doing something sub-optimally; however, in the if statement If rs2.EOF Then, why not add a comparison to a and then redirect to a different Excel file for 0, 1, 2 and 3
Bruit Force and Ignorance, but definitely segregated.